Changeset 759


Ignore:
Timestamp:
May 26, 2003, 7:01:45 PM (18 years ago)
Author:
orlov
Message:
  • Work towards clashes compilation. All examples are compiled in the right code now.
Location:
to-imperative/trunk/compiler
Files:
2 added
9 edited

Legend:

Unmodified
Added
Removed
  • to-imperative/trunk/compiler/Makefile

    r683 r759  
    2323  rfp_vars \
    2424  rfp_const \
     25  rfp_clashes \
    2526  rfp_asail_optim
    2627
  • to-imperative/trunk/compiler/rfp_as2as.rf

    r683 r759  
    379379//
    380380//$func? Middle-Exp s.left s.right e.expr = (e.expr) e.change;
     381//
     382*$func Comp-Pattern t.Pattern e.Snt = e.asail-Snt;
     383*
     384*Comp-Pattern (s.dir e.PatternExp) e.Sentence =
     385*       <Norm-Vars (<Vars e.PatternExp>) (s.dir e.PatternExp) e.Sentence>
     386*               : t t.Pattern e.Snt,
     387*//     (Unwatched (<? &Last-Re>) t.Pattern) e.Snt $iter {
     388*       /*
     389*        * Uncomment previous line and delete next one to activate Split-Clashes
     390*        * function
     391*        */
     392*       ((<? &Last-Re>) t.Pattern) e.Snt $iter {
     393*               e.Snt : (RESULT e.Re) (s.d e.Pe) e =
     394*//                     <WriteLN Matching (RESULT e.Re) (s.d e.Pe)>,
     395*                       <Norm-Vars (<Vars e.Pe>) e.Snt> : t t.R t.P e.rest,
     396*//                     (e.clashes Unwatched (e.Re) t.P) e.rest;
     397*                       /*
     398*                        * Uncomment previous line and delete next one to activate
     399*                        * Split-Clashes function
     400*                        */
     401*                       (e.clashes (e.Re) t.P) e.rest;
     402*       } :: (e.clashes) e.Snt,
     403*       # \{
     404*               e.Snt : \{
     405*                       (RESULT e.Re) (LEFT e) e = e.Re;
     406*                       (RESULT e.Re) (RIGHT e) e = e.Re;
     407*               } :: e.Re,
     408*                       <Without-Calls? e.Re>;
     409*       } =
     410*       e.Snt : e.Current-Snt (Comp Sentence) e.Other-Snts =
     411*       <Comp-Sentence () e.Other-Snts> :: e.asail-Others,
     412*       {
     413*//             <Split-Clashes (e.clashes) e.Current-Snt>
     414*//             :: (e.greater) (e.less) (e.hards) (e.clashes) e.Current-Snt =
     415*//                     <WriteLN "Hards: " e.hards>,
     416*//                     <WriteLN "Less: " e.less>,
     417*//                     <WriteLN "Greater: " e.greater>,
     418*//                     <WriteLN "Current-Snt: " e.Current-Snt>,
     419*//!                    <Comp-Clashes (e.clashes)
     420*//!                            (e.Current-Snt (Comp Sentence)) e.Other-Snts> :: e.asail-Clashes,
     421*//                     e.asail-Clashes (e.greater) $iter {
     422*//                             e.greater : (e.vars s.num) e.rest,
     423*//                                     <Old-Vars e.vars> :: e.vars,  // temporary step
     424*//                                     (IF ((INFIX ">=" ((LENGTH e.vars)) (s.num)))
     425*//                                             e.asail-Clashes
     426*//                                     ) (e.rest);
     427*//                     } :: e.asail-Clashes (e.greater),
     428*//                     e.greater : /*empty*/ =
     429*//                     e.asail-Clashes (e.less) $iter {
     430*//                             e.less : (e.vars s.num) e.rest,
     431*//                                     <Old-Vars e.vars> :: e.vars,  // temporary step
     432*//                                     (IF ((INFIX "<=" ((LENGTH e.vars)) (s.num)))
     433*//                                             e.asail-Clashes
     434*//                                     ) (e.rest);
     435*//                     } :: e.asail-Clashes (e.less),
     436*//                     e.less : /*empty*/ =
     437*//                     e.asail-Clashes (e.hards) $iter {
     438*//                             e.hards : (e.Re) (e.Pe) e.rest,
     439*//                                     <Old-Vars e.Re> :: e.Re,    // temporary step
     440*//                                     <Old-Vars e.Pe> :: e.Pe,    // temporary step
     441*//                                     (IF ((INFIX "==" (e.Re) (e.Pe))) e.asail-Clashes) (e.rest);
     442*//                     } :: e.asail-Clashes (e.hards),
     443*//                     e.hards : /*empty*/ =
     444*//!                    e.asail-Clashes e.asail-Others;
     445*               e.asail-Others;
     446*//             <Comp-Sentence () e.Other-Snts>;
     447*       };
    381448//
    382449//Split-Clashes (e.clashes) e.Snt =
  • to-imperative/trunk/compiler/rfp_asail.rf

    r751 r759  
    8282      } :: e.label,
    8383      ('for ( ; ' <Cond-To-CPP e.cond> '; ' <Step-To-CPP e.step> ')')
    84       ('{' ('{' (<ASAIL-To-CPP e.body>) '}') e.label '}');
     84//      ('{' ('{' (<ASAIL-To-CPP e.body>) '}') e.label '}');
     85      ('{' (<ASAIL-To-CPP e.body>) '}');
    8586    (LABEL (e.label) e.body) =
    8687      {
     
    121122      (<Rfp2Cpp t.var> '.drop ();');
    122123    (CONTINUE t.label) =
    123       ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
     124//      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
     125      ('continue;');
    124126    (BREAK t.label) =
    125127      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
  • to-imperative/trunk/compiler/rfp_compile.rf

    r750 r759  
    1212$use "rfp_vars";
    1313$use "rfp_const";
     14$use "rfp_clashes";
    1415
    1516$use StdIO;
     
    2526
    2627/*
    27  * Tables for storing $const'ant values and their lengthes.
    28  */
    29 $table Const-Len;
    30 
    31 /*
    3228 * Table for storing object names.
    3329 */
     
    9591$func Extract-Calls e.Re = (e.last-Re) e.calls;
    9692
     93$func Get-Clash-Sequence (e.last-Re) e.Snt = (e.clashes) e.rest-of-the-Sentence;
     94
     95$func? Without-Calls? e.Re = ;
     96
     97//$func Old-Vars e.expr = e.expr;
     98
     99//$func Find-Known-Lengths e.clashes = (e.known-len-clashes) e.clashes;
     100
     101//$func? Known-Vars? e.vars = ;
     102
     103$func Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence = e.asail-sentence;
     104
     105$func? Find-Var-Length e.clashes = e.cond (e.clashes);
     106
     107$func Update-Ties t.var e.clashes = e.clashes;
     108
     109$func Known-Length-of e.expr = e.known-length (e.unknown-vars);
     110
     111$func? Cyclic-Restrictions e.clashes = e.cond (e.clashes);
     112
     113$func Cyclic-Min t.var = e.min;
     114
     115$func? Cyclic-Max t.var = e.max;
     116
     117$func? Check-Symbols e.clashes = e.cond (e.clashes) s.new?;
     118
     119$func? Check-Ft t.Ft (e.pos) (e.right-pos) t.name s.dir = e.Ft-cond s.stop?;
     120
     121$func Compare-Subexpr e.clashes = e.cond (e.asserts) (e.clashes) s.new?;
     122
     123$func Compare-Ft t.Ft = e.Ft-cond s;
     124
     125$func? Get-Source e.clashes = e.cond (e.clashes);
     126
     127$func Compose-Expr e.expr = e.compose (e.not-instantiated-vars) s.flat?;
     128
     129$func? Comp-Cyclic e.clashes = e.cond (e.clashes) (e.fail);
     130
     131$func Get-Subexprs e.vars = e.asail-decls;
     132
     133$func Unknown-Vars e.expr = e.known-expr (e.unknown-vars);
     134
     135$func Split-Hard-Left e.expr = e.hard;
     136
     137$func Split-Hard-Right e.expr = e.hard;
     138
     139$func Gener-Label e.QualifiedName = t.label;
     140
     141$func Add-To-Label t.label e.name = t.label;
     142
     143$func Comp-Calls e.Re = e.calls;
     144
    97145$func Comp-Static-Exprs e.Reult-exprs = e.Result-exprs;
    98 
    99 $func Get-Clash-Sequence (e.last-Re) e.Snt = (e.clashes) e.rest-of-the-Sentence;
    100 
    101 $func Comp-Pattern t.Pattern e.Snt = e.asail-Snt;
    102 
    103 $func? Without-Calls? e.Re = ;
    104 
    105 //$func Old-Vars e.expr = e.expr;
    106 
    107 //$func Find-Known-Lengths e.clashes = (e.known-len-clashes) e.clashes;
    108 
    109 //$func? Known-Vars? e.vars = ;
    110 
    111 $func Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence = e.asail-sentence;
    112 
    113 $func? Find-Var-Length e.clashes = e.cond (e.clashes);
    114 
    115 $func Update-Ties t.var e.clashes = e.clashes;
    116 
    117 $func Known-Length-of e.expr = e.known-length (e.unknown-vars);
    118 
    119 $func? Cyclic-Restrictions e.clashes = e.cond (e.clashes);
    120 
    121 $func Cyclic-Min t.var = e.min;
    122 
    123 $func? Cyclic-Max t.var = e.max;
    124 
    125 $func? Check-Symbols e.clashes = e.cond (e.clashes) s.new?;
    126 
    127 $func? Check-Ft t.Ft (e.pos) (e.right-pos) t.name s.dir = e.Ft-cond s.stop?;
    128 
    129 $func? Dereference-Subexpr e.clashes = e.cond (e.clashes);
    130 
    131 $func Compare-Subexpr e.clashes = e.cond (e.asserts) (e.clashes) s.new?;
    132 
    133 $func Compare-Ft t.Ft = e.Ft-cond s;
    134 
    135 $func? Get-Source e.clashes = e.cond (e.clashes);
    136 
    137 $func Compose-Expr e.expr = e.compose (e.not-instantiated-vars) s.flat?;
    138 
    139 $func? Comp-Cyclic e.clashes = e.cond (e.clashes) (e.fail);
    140 
    141 $func Get-Subexprs e.vars = e.asail-decls;
    142 
    143 $func Unknown-Vars e.expr = e.known-expr (e.unknown-vars);
    144 
    145 $func Split-Hard-Left e.expr = e.hard;
    146 
    147 $func Split-Hard-Right e.expr = e.hard;
    148 
    149 $func Gener-Label e.QualifiedName = t.label;
    150 
    151 $func Add-To-Label t.label e.name = t.label;
    152 
    153 $func Comp-Calls e.Re = e.calls;
    154146
    155147$func Comp-Assigns e.assignments = e.asail-assignments;
     
    258250//!     <Declare-Vars Expr e.arg-vars> : e,
    259251  <Vars e.in> :: e.arg-vars,
    260   <Map &Ref-Set-Var (Instantiated? True) (e.arg-vars)> : e,
     252  <Map &Set-Var- (Instantiated? True) (e.arg-vars)> : e,
    261253*       <Vars-Decl e.arg-vars> : e,
    262254*       <Instantiate-Vars e.arg-vars>,
     
    410402  (s.dir e.Pattern) e.Snt, s.dir : \{ LEFT; RIGHT; } =
    411403    <Get-Clash-Sequence (e.last-Re) e.Sentence> :: (e.clashes) e.Sentence,
    412 //    <WriteLN !!! e.clashes>,
     404//    <WriteLN XXX e.clashes>,
    413405    <Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence>;
    414406
     
    528520  (Comp Iter (BRANCH e.body) t.format (BRANCH e.condition)) e.Snt =
    529521    <Gener-Label "iter"> :: t.label,
     522    <Gener-Label "exit_iter"> :: t.exit,
    530523    <Save-Snt-State>,
    531524    <Comp-Sentence s.tail? (v.fails ((BREAK t.label))) () e.condition e.Snt>
     
    533526    <Pop-Snt-State>,
    534527    <Comp-Sentence Notail (v.fails) () e.body t.format> :: e.comp-body,
    535     (FOR () () () (LABEL (t.label) e.comp-condition) e.comp-body);
     528    (LABEL (t.exit)
     529      (FOR () () () (LABEL (t.label) e.comp-condition (BREAK t.exit)) e.comp-body)
     530    );
    536531
    537532  /*
     
    685680    <Gener-Vars (e.Fout) e.prefix> :: /*(e.vars)*/ e.Re,
    686681    <Vars e.Re> :: e.vars,
    687     <Map &Ref-Set-Var (Instantiated? True) (e.vars)> : e,
     682    <Map &Set-Var- (Instantiated? True) (e.vars)> : e,
    688683    {
    689684      s.tag : FUNC? =   (Failable (CALL t.name (e.splited-Re) (e.vars)));
     
    10321027
    10331028
     1029****************** Компиляция сопоставления с образцом *******************
     1030
    10341031Get-Clash-Sequence (e.last-Re) t.Pattern e.Snt =
    1035   ((e.last-Re) t.Pattern) e.Snt $iter {
    1036     e.Snt : (RESULT e.Re) t.Pt e.rest =
    1037       (e.clashes (e.Re) t.Pt) e.rest;
     1032  (/*e.clashes*/) (RESULT e.last-Re) t.Pattern e.Snt $iter {
     1033    e.Snt : (RESULT e.Re) (s.dir e.Pe) e.rest =
     1034      /*
     1035       * Компилируем все константные выражения и заводим в табличке все
     1036       * незаведённые переменные.  У старых переменных очищается память
     1037       * на предмет клешей, в которых они раньше использовались.
     1038       */
     1039      <Comp-Static-Exprs (e.Re) (e.Pe)> : (e.R1) (e.P1),
     1040      <Map &Set-Var- (Clashes /*empty*/) (<Vars e.R1 e.P1>)> : e,
     1041      (e.clashes (e.R1) (s.dir e.P1)) e.rest;
    10381042  } :: (e.clashes) e.Snt,
    10391043  # \{
     
    10451049  } =
    10461050  (e.clashes) e.Snt;
    1047 
    1048 
    1049 Comp-Pattern (s.dir e.PatternExp) e.Sentence =
    1050   <Norm-Vars (<Vars e.PatternExp>) (s.dir e.PatternExp) e.Sentence>
    1051     : t t.Pattern e.Snt,
    1052 //  (Unwatched (<? &Last-Re>) t.Pattern) e.Snt $iter {
    1053   /*
    1054    * Uncomment previous line and delete next one to activate Split-Clashes
    1055    * function
    1056    */
    1057   ((<? &Last-Re>) t.Pattern) e.Snt $iter {
    1058     e.Snt : (RESULT e.Re) (s.d e.Pe) e =
    1059 //      <WriteLN Matching (RESULT e.Re) (s.d e.Pe)>,
    1060       <Norm-Vars (<Vars e.Pe>) e.Snt> : t t.R t.P e.rest,
    1061 //      (e.clashes Unwatched (e.Re) t.P) e.rest;
    1062       /*
    1063        * Uncomment previous line and delete next one to activate
    1064        * Split-Clashes function
    1065        */
    1066       (e.clashes (e.Re) t.P) e.rest;
    1067   } :: (e.clashes) e.Snt,
    1068   # \{
    1069     e.Snt : \{
    1070       (RESULT e.Re) (LEFT e) e = e.Re;
    1071       (RESULT e.Re) (RIGHT e) e = e.Re;
    1072     } :: e.Re,
    1073       <Without-Calls? e.Re>;
    1074   } =
    1075   e.Snt : e.Current-Snt (Comp Sentence) e.Other-Snts =
    1076   <Comp-Sentence () e.Other-Snts> :: e.asail-Others,
    1077   {
    1078 //    <Split-Clashes (e.clashes) e.Current-Snt>
    1079 //    :: (e.greater) (e.less) (e.hards) (e.clashes) e.Current-Snt =
    1080 //      <WriteLN "Hards: " e.hards>,
    1081 //      <WriteLN "Less: " e.less>,
    1082 //      <WriteLN "Greater: " e.greater>,
    1083 //      <WriteLN "Current-Snt: " e.Current-Snt>,
    1084 //!                     <Comp-Clashes (e.clashes)
    1085 //!                             (e.Current-Snt (Comp Sentence)) e.Other-Snts> :: e.asail-Clashes,
    1086 //      e.asail-Clashes (e.greater) $iter {
    1087 //        e.greater : (e.vars s.num) e.rest,
    1088 //          <Old-Vars e.vars> :: e.vars,  // temporary step
    1089 //          (IF ((INFIX ">=" ((LENGTH e.vars)) (s.num)))
    1090 //            e.asail-Clashes
    1091 //          ) (e.rest);
    1092 //      } :: e.asail-Clashes (e.greater),
    1093 //      e.greater : /*empty*/ =
    1094 //      e.asail-Clashes (e.less) $iter {
    1095 //        e.less : (e.vars s.num) e.rest,
    1096 //          <Old-Vars e.vars> :: e.vars,  // temporary step
    1097 //          (IF ((INFIX "<=" ((LENGTH e.vars)) (s.num)))
    1098 //            e.asail-Clashes
    1099 //          ) (e.rest);
    1100 //      } :: e.asail-Clashes (e.less),
    1101 //      e.less : /*empty*/ =
    1102 //      e.asail-Clashes (e.hards) $iter {
    1103 //        e.hards : (e.Re) (e.Pe) e.rest,
    1104 //          <Old-Vars e.Re> :: e.Re,    // temporary step
    1105 //          <Old-Vars e.Pe> :: e.Pe,    // temporary step
    1106 //          (IF ((INFIX "==" (e.Re) (e.Pe))) e.asail-Clashes) (e.rest);
    1107 //      } :: e.asail-Clashes (e.hards),
    1108 //      e.hards : /*empty*/ =
    1109 //!                     e.asail-Clashes e.asail-Others;
    1110     e.asail-Others;
    1111 //    <Comp-Sentence () e.Other-Snts>;
    1112   };
    11131051
    11141052Without-Calls? e.Re =
     
    11251063  e.Re : /*empty*/;
    11261064
    1127 //Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts =
    1128 //  <WriteLN Clashes e.clashes>,
    1129 ////  /*
    1130 ////   * Collect in e.vars all varibles from all clashes.
    1131 ////   */
    1132 ////  () e.clashes $iter {
    1133 ////    e.not-watched : (e.expr) e.rest = (e.vars <Vars e.expr>) e.rest;
    1134 ////  } :: (e.vars) e.not-watched,
    1135 ////  e.not-watched : /*empty*/ =
    1136 ////  /*
    1137 ////   * Rename all collected variables in all clashes. Never mind multiple
    1138 ////   * occurences.
    1139 ////   */
    1140 ////  (e.clashes) e.vars $iter {
    1141 ////    e.vars : (s.var-tag s.m (e.n) e.var-id) e.rest, {
    1142 ////      <Known-Vars? (s.var-tag e.var-id)> =
    1143 ////        e.var-id : e.NEW (e.QualifiedName),
    1144 ////        <Subst ((s.var-tag s.m (e.n) e.var-id))
    1145 ////          (((s.var-tag (s.var-tag NEW ("len" e.QualifiedName))
    1146 ////          s.m (e.n) e.var-id))) e.clashes>;
    1147 ////      s.m : e.n =
    1148 ////        <Subst ((s.var-tag s.m (e.n) e.var-id))
    1149 ////          (((s.var-tag (s.m) s.m (e.n) e.var-id))) e.clashes>;
    1150 ////    } :: e.clashes,
    1151 ////    (e.clashes) e.rest;
    1152 ////  } :: (e.clashes) e.vars,
    1153 ////  e.vars : /*empty*/ =
    1154 ////  /*
    1155 ////   * Now all variables with known length have ref. term after s.var-tag.
    1156 ////   * Well, lets see if there are closed variables and compute their lengthes
    1157 ////   * too.
    1158 ////   */
    1159 ////  e.clashes (e.clashes) () $iter {
    1160 ////    e.not-watched : (e.Re) (s.dir e.Pe) e.rest, {
    1161 ////      <Find-Closed-Var e.Pe> :: t.old-var t.new-var e.new-cond,
    1162 ////        <Subst (t.old-var) ((t.new-var)) e.clashes> :: e.clashes,
    1163 ////        e.clashes (e.clashes) (e.cond e.new-cond);
    1164 ////      e.rest (e.clashes) (e.cond);
    1165 ////    };
    1166 ////  } :: e.not-watched (e.clashes) (e.cond),
    1167 ////  e.not-watched : /*empty*/ =
    1168 //
    1169 //  /*
    1170 //   * Parenthesize each clash, so from now on they can be seen as a sequence
    1171 //   * of such terms: (e.temp-tags (e.Re) t.P)
    1172 //   */
    1173 //  e.clashes () $iter {
    1174 //    e.old-clashes : t.R t.P e.rest =
    1175 //      e.rest (e.clashes (t.R t.P));
    1176 //  } :: e.old-clashes e.clashes,
    1177 //  e.old-clashes : /*empty*/ =
    1178 // 
    1179 //  <Find-Known-Lengths e.clashes> :: (e.known-len-clashes) e.clashes,
    1180 //  {
    1181 //    e.known-len-clashes : /*empty*/ =
    1182 //      <Find-Symbol-Checks e.clashes> :: (e.sym-check-clashes) e.clashes,
    1183 //      {
    1184 //        e.sym-check-clashes : /*empty*/ =
    1185 //          e.clashes : {
    1186 //            (e.Re) (s.dir e.Pe) e.rest =
    1187 //              <Gener-Label L> :: t.label,
    1188 //              <Comp-Clashes (e.rest) (e.Current-Snt)
    1189 //                (Comp Continue t.label) e.Other-Snts>
    1190 //              :: e.asail-Snt,
    1191 //              (FOR t.label () () ()
    1192 //                e.asail-Snt
    1193 //              )
    1194 //              <Comp-Sentence () e.Other-Snts>;
    1195 //            /*empty*/ =
    1196 //              <Comp-Sentence () e.Current-Snt e.Other-Snts>;
    1197 //          };
    1198 //        <Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts> :: e.asail-Snt,
    1199 //          (e.sym-check-clashes) e.asail-Snt $iter {
    1200 //            e.sym-check-clashes : e.something (e (e.Re) (s.dir e.Pe)),
    1201 //             
    1202 //    <Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts> :: e.asail-Snt,
    1203 //      (e.known-len-clashes) e.asail-Snt $iter {
    1204 //        e.known-len-clashes : e.something (e.tags (e.Re) (s.dir e.Pe)),
    1205 //          (e.something)
    1206 //          (IF ((INFIX "==" (<Length-of e.Re>) (<Length-of e.Pe>)))
    1207 //            e.asail-Snt
    1208 //          );
    1209 //      } :: (e.known-len-clashes) e.asail-Snt,
    1210 //      e.known-len-clashes : /*empty*/ =
    1211 //      e.asail-Snt
    1212 //      <Comp-Sentence () e.Other-Snts>;
    1213 //  };
    1214 //
    1215 //Find-Known-Lengths e.clashes =
    1216 //  e.clashes () () $iter {
    1217 //    e.old-clashes : t.first e.rest, t.first : {
    1218 //      (e1 Known-length e2) =
    1219 //        e.rest (e.known) (e.clashes t.first);
    1220 //      (e.tags (e.Re) (s.dir e.Pe)) =
    1221 ////        Known <Vars e.Re> <Vars e.Pe> $iter {
    1222 ////          e.vars : (VAR t.name) e.rest-vars, {
    1223 ////            <?? t.name Length> : e = Known;
    1224 ////            <?? t.name Instantiated> : True = Known;
    1225 ////            Unknown;
    1226 ////          } :: s.known? =
    1227 ////            s.known? e.rest-vars;
    1228 ////        } :: s.known? e.vars,
    1229 ////        \{
    1230 ////          s.known? : Unknown =
    1231 ////            e.rest (e.known) (e.clashes t.first);
    1232 ////          e.vars : /*empty*/ =
    1233 ////            e.rest (e.known t.first)
    1234 ////            (e.clashes (e.tags Known-length (e.Re) (s.dir e.Pe)));
    1235 ////        };
    1236 //        {
    1237 //          <Hard-Exp? <Vars e.Re> <Vars e.Pe>> =
    1238 //            e.rest (e.known t.first)
    1239 //            (e.clashes (e.tags Known-length (e.Re) (s.dir e.Pe)));
    1240 //          e.rest (e.known) (e.clashes t.first);
    1241 //        };
    1242 //    };
    1243 //  } :: e.old-clashes (e.known) (e.clashes),
    1244 //  e.old-clashes : /*empty*/ =
    1245 //  (e.known) e.clashes;
    1246 //
    1247 //Known-Vars? e.vars =
    1248 //  <? &Var-Stack> :: e.known-vars,
    1249 //  e.vars $iter {
    1250 //    e.vars : t.var e.rest =
    1251 //      e.known-vars : e t.var e,
    1252 //      e.rest;
    1253 //  } :: e.vars,
    1254 //  e.vars : /*empty*/;
    1255 
    1256 $func CC (e.clashes) s.tail? (v.fails) e.Snt = e.asail-Snt;
    1257 
    1258 $const New-Clash-Tags = Unknown-length Ties Check-symbols Deref Compare;
     1065
     1066$func CC s.tail? (v.fails) t.end-cycle e.Snt = e.asail-Snt;
    12591067
    12601068Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence =
    1261 //  <WriteLN Clashes e.clashes>,
    1262   /*
    1263    * Parenthesize each clash, so from now on they can be seen as a sequence
    1264    * of such terms: (e.temp-tags (e.Re) t.P)
    1265    */
    1266   e.clashes () $iter {
    1267     e.old-clashes : (e.Re) (s.dir e.Pe) e.rest =
    1268       <Comp-Static-Exprs (e.Re) (e.Pe)> : (e.R1) (e.P1),
    1269       <Map &Ref-Set-Var (<Vars e.R1 e.P1>)> : e,
    1270       e.rest (e.clashes (<Gener-Label "clash"> &New-Clash-Tags (e.R1) (s.dir e.P1)));
    1271   } :: e.old-clashes (e.clashes),
    1272   e.old-clashes : /*empty*/ =
    1273   <CC (e.clashes) s.tail? (v.fails) e.Sentence>;
    1274 
    1275 $func Get-Known-Length e.expr = e.length-of-known-part (e.unknown-vars);
    1276 
    1277 $func Cyclic-Restr (e.fail) (e.watched-clashes) e.clashes = e.cond (e.clashes);
    1278 
    1279 $func Deref-Exprs
    1280     (e.fail) (e.conds) (e.assigns) e.clashes = e.clashes (e.conds) (e.assigns);
    1281 
    1282 $func Compare-Subexprs (e.fail) (e.conds) e.clashes = e.clashes (e.conds);
    1283 
    1284 $func? Comp-Cycle e.clashes = t t t e.clashes;
    1285 
    1286 $func Assign-Value e = e;
    1287 
    1288 CC (e.clashes) s.tail? (e.prev-fails (e.fail)) e.Snt, {
    1289   e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2,
    1290     <Get-Known-Length e.Re> :: e.len-Re (e.vars-Re),
    1291     <Get-Known-Length e.Pe> :: e.len-Pe (e.vars-Pe),
    1292     \{
    1293       /*
    1294        * Если длины всех переменных на верхних уровнях e.Re и e.Pe
    1295        * известны, то надо просто выписать условие на равенство длин
    1296        * выражения и образца.
    1297        */
    1298       e.vars-Re : /*empty*/, e.vars-Pe : /*empty*/ =
    1299         (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
    1300         <CC (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2)
    1301           s.tail? (e.prev-fails (e.fail)) e.Snt>;
    1302       /*
    1303        * Если неизвестная переменная во всём клеше ровно одна, и она
    1304        * входит в левую и правую части разное кол-во раз, то её длину
    1305        * можно вычислить.
    1306        *
    1307        * Если же она входит в левую и правую части одинаковое кол-во раз,
    1308        * то остальные составляющие клеша проверяются на равенство, и он
    1309        * объявляется циклическим до вычисления этой переменной.
    1310        */
    1311       <Nub e.vars-Re e.vars-Pe> : t.var, {
    1312         <"-" <Length e.vars-Re> <Length e.vars-Pe>> :: s.diff,
    1313           <"/=" (s.diff) (0)> =
    1314           {
    1315             <"<" (s.diff) (0)> = <"*" s.diff -1> (e.len-Re) (e.len-Pe);
    1316             s.diff (e.len-Pe) (e.len-Re);
    1317           } :: s.mult (e.minuend) (e.subtrahend),
    1318           <Create-Int-Var ("len") Aux e.minuend> :: t.m-var e.m-assign,
    1319           <Create-Int-Var ("len") Aux e.subtrahend> :: t.s-var e.s-assign,
    1320           <Get-Var Min t.var> :: e.min,
    1321           ((INFIX "<" (t.m-var)
    1322                 ((INFIX "+" (t.s-var)
    1323                       ((INFIX "*" (e.min) (s.mult)))
    1324           ))                    )) :: e.min-cond,
    1325           <Get-Var Max t.var> : {
    1326             /*empty*/;
    1327             e.max =
    1328               ((INFIX ">" (t.m-var)
    1329                     ((INFIX "+" (t.s-var)
    1330                           ((INFIX "*" (e.max) (s.mult)))
    1331               ))                        ));
    1332           } :: e.max-cond,
    1333           (INFIX "%" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult)) :: e.div-cond,
    1334           <Create-Int-Var ("len_") t.var
    1335             (INFIX "/" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult))
    1336           > :: t.len-var e.len-assign,
    1337           <Set-Var (Length t.len-var) t.var>,
    1338           e.m-assign e.s-assign
    1339           (IF ((INFIX "||" e.min-cond e.max-cond)) e.fail)
    1340           (IF (e.div-cond) e.fail)
    1341           e.len-assign
    1342           <CC (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2)
    1343             s.tail? (e.prev-fails (e.fail)) e.Snt>;
    1344 
    1345         (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
    1346           <CC (e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2)
    1347             s.tail? (e.prev-fails (e.fail)) e.Snt>;
    1348       };
    1349     };
    1350 
    1351   /*
    1352    * Перебрали все клеши, из которых можно было вычислить что-то определённое
    1353    * про длины.
    1354    *
    1355    * Теперь выпишем неравенства на длины, накладываемые остальными клешами.
    1356    */
    1357   <Cyclic-Restr (e.fail) (/*e.watched*/) e.clashes> :: e.cond (e.clashes),
    1358 
    1359     <Deref-Exprs (e.fail) (/*e.conds*/) (/*e.assigns*/) e.clashes> : {
    1360       e.new-clashes (v.conds) (v.assigns) =
    1361         e.cond v.conds v.assigns
    1362         <CC (e.new-clashes) s.tail? (e.prev-fails (e.fail)) e.Snt>;
    1363 
    1364       /*
    1365        * If previous doesn't work then compare recursively all known
    1366        * subexpressions and all unknown repeated subexpressions with
    1367        * corresponding parts of source.
    1368        */
    1369       e.new-clashes () () =
    1370         <Compare-Subexprs (e.fail) () e.new-clashes> :: e.clashes (e.cond2),
    1371         e.new-clashes (/*e.assigns*/) $iter {
    1372           e.new-clashes : (e (e.Re) (s.dir e.Pe)) e.rest =
    1373             e.rest (e.assigns <Map &Assign-Value (<Vars e.Pe>)>);
    1374         } :: e.new-clashes (e.assigns),
    1375         e.new-clashes : /*empty*/ =
    1376         {
    1377           <Comp-Cycle e.clashes> :: t.var t.l-var t.r-var e.clashes =
    1378             <Gener-Label L "For" "Cont"> :: t.cont-label,
    1379             <Gener-Label L "For" "Break"> :: t.break-label,
    1380             e.cond e.cond2 e.assigns
    1381             (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
    1382             (LABEL (t.break-label)
    1383               (FOR (t.cont-label) () ((INC-ITER t.var))
    1384                 <CC (e.clashes) s.tail?
    1385                   (e.prev-fails (e.fail))
    1386                   (Comp Fail ((CONTINUE t.cont-label))) e.Snt>
    1387                 (BREAK t.break-label)
    1388               )
    1389             );
    1390           e.cond e.cond2 e.assigns
    1391           <Comp-Sentence s.tail? (e.prev-fails (e.fail)) () e.Snt>;
     1069  <Init-Clashes e.clashes>,
     1070  <CC s.tail? (v.fails) <R 0 v.fails> e.Sentence>;
     1071
     1072$func CC-Known-Lengths t.fail e.idxs = e.conds;
     1073
     1074$func CC-Compute-Length t.fail t.end-cycle t.idx = e;
     1075
     1076$func CC-Unknown-Lengths t.fail e.idxs = e.conds;
     1077
     1078$func CC-Deref t.fail e.actions = e.actions;
     1079
     1080$func CC-Eqs t.fail (e.assigns) e.eqs = e.actions;
     1081
     1082$func CC-Compose-And-Compare t.fail = e.actions;
     1083
     1084CC s.tail? (v.fails) t.end-cycle e.Snt, {
     1085  <Domain &Known-Lengths> : v.clashes =
     1086    <CC-Known-Lengths t.end-cycle v.clashes>
     1087    <CC s.tail? (v.fails) t.end-cycle e.Snt>;
     1088  <Domain &Compute-Length> : (t.clash) e =
     1089    <CC-Compute-Length <R 0 v.fails> t.end-cycle t.clash>
     1090    <CC s.tail? (v.fails) t.end-cycle e.Snt>;
     1091  <Domain &Unknown-Lengths> : e.clashes =
     1092    <CC-Unknown-Lengths t.end-cycle e.clashes> :: e.conds,
     1093    <Update-Hard-Parts> : {
     1094      v.actions =
     1095        e.conds <CC-Deref <R 0 v.fails> v.actions>
     1096        <CC s.tail? (v.fails) t.end-cycle e.Snt>;
     1097      /*empty*/ =
     1098        <Compose-Source-For-Deref> : {
     1099          (e.assign) v.clshs =
     1100            <Map &Reclassify-Clash (v.clshs)> : e,
     1101            e.conds e.assign <CC s.tail? (v.fails) t.end-cycle e.Snt>;
     1102          () /*empty*/ =
     1103            e.conds <CC-Eqs <R 0 v.fails> () <? &Eqs>> :: e.actions,
     1104            <Store &Eqs /*empty*/>,
     1105            e.actions <CC-Compose-And-Compare <R 0 v.fails>> :: e.actions,
     1106            {
     1107              <Get-Cycle> :: t.var t.l-var t.r-var =
     1108                <Gener-Label L "For" "Cont"> :: t.cont-label,
     1109                <Gener-Label L "For" "Break"> :: t.break-label,
     1110                e.actions
     1111                (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
     1112                (LABEL (t.break-label)
     1113                  (FOR (t.cont-label) () ((INC-ITER t.var))
     1114                    <CC s.tail? (v.fails ((CONTINUE t.cont-label)))
     1115                      <R 0 v.fails> e.Snt>
     1116                    (BREAK t.break-label)
     1117                  )
     1118                );
     1119              e.actions <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     1120            };
    13921121        };
    13931122    };
    13941123};
    13951124
    1396 
    1397 
    1398 Assign-Value t.var =
    1399   {
    1400     <Get-Var Value t.var> : (expr) (e.pos) (e.len) =
    1401       (SUBEXPR t.var expr (e.pos) (e.len));
     1125CC-Known-Lengths (e.fail) e.idxs, {
     1126  e.idxs : (t.idx) e.rest =
     1127    <Put &Checked-Lengths t.idx>,
     1128    <Lookup &Known-Lengths t.idx> : (e.len-Re) (e.len-Pe),
     1129    (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
     1130    <CC-Known-Lengths (e.fail) e.rest>;
     1131  <RFP-Clear-Table &Known-Lengths>;
     1132};
     1133
     1134CC-Compute-Length (e.fail) (e.end-cycle) t.idx =
     1135  <Lookup &Compute-Length t.idx> : t.var s.mult (e.minuend) (e.subtrahend),
     1136  <Create-Int-Var ("len") Aux e.minuend> :: t.m-var e.m-assign,
     1137  <Create-Int-Var ("len") Aux e.subtrahend> :: t.s-var e.s-assign,
     1138  <Get-Var Min t.var> :: e.min,
     1139  ((INFIX "<" (t.m-var)
     1140        ((INFIX "+" (t.s-var)
     1141              ((INFIX "*" (e.min) (s.mult)))
     1142  ))                    )) :: e.min-cond,
     1143  <Get-Var Max t.var> : {
    14021144    /*empty*/;
    1403   };
    1404 
    1405 
     1145    e.max =
     1146      ((INFIX ">" (t.m-var)
     1147            ((INFIX "+" (t.s-var)
     1148                  ((INFIX "*" (e.max) (s.mult)))
     1149      ))                        ));
     1150  } :: e.max-cond,
     1151  (INFIX "%" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult)) :: e.div-cond,
     1152  <Create-Int-Var ("len_") t.var
     1153    (INFIX "/" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult))
     1154  > :: t.len-var e.len-assign,
     1155  <Set-Var (Length t.len-var) t.var>,
     1156  <Unbind &Compute-Length t.idx>,
     1157  <Put &Checked-Lengths t.idx>,
     1158  <Get-Var Clashes t.var> :: e.clashes,
     1159  <Map &Reclassify-Clash (<Sub (e.clashes) <? &Checked-Lengths>>)> : e,
     1160  e.m-assign e.s-assign
     1161  (IF ((INFIX "||" e.min-cond e.max-cond)) e.end-cycle)
     1162  (IF (e.div-cond) e.fail)
     1163  e.len-assign;
    14061164
    14071165$func  Get-Min e = e;
     
    14091167$func? Get-Max e = e;
    14101168
    1411 Cyclic-Restr (e.fail) (e.watched) e.clashes, {
    1412   e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2,
    1413     <Get-Known-Length e.Re> :: e.len-Re (e.vars-Re),
    1414     <Get-Known-Length e.Pe> :: e.len-Pe (e.vars-Pe),
     1169CC-Unknown-Lengths (e.fail) e.idxs, {
     1170  e.idxs : (t.idx) e.rest =
     1171    <Lookup &Unknown-Lengths t.idx> : (e.len-Re) (e.len-Pe) (e.vars-Re) (e.vars-Pe),
    14151172    {
    14161173      <Get-Max e.vars-Re> :: e.max =
     
    14301187    } :: e.cond,
    14311188    e.cond
    1432     <Cyclic-Restr (e.fail) (e.watched e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe))) e2>;
    1433   (e.watched e.clashes);
     1189    <CC-Unknown-Lengths (e.fail) e.rest>;
     1190  <RFP-Clear-Table &Unknown-Lengths>;
    14341191};
    14351192
     
    14451202  /*empty*/ = /*empty*/;
    14461203};
     1204
     1205$func Pos (e.Re) s.dir e.pos = e.pos;
     1206
     1207Pos {
     1208  (e.Re) RIGHT e.pos = (INFIX "-" ((LENGTH e.Re)) ((e.pos)));
     1209  (e.Re) LEFT  e.pos = e.pos;
     1210};
     1211
     1212$func? Flat? e.Re = ;
     1213
     1214Flat? term =
     1215  \{
     1216    <Get-Var Flat? term> : True;
     1217    term : \{
     1218      (REF e) = term;
     1219      (STATIC e) = <Get-Static term>;
     1220    } :: e.Re,
     1221      <Flat-Const? e.Re>;
     1222  };
     1223
     1224CC-Deref (e.fail) e.actions, e.actions : {
     1225  (SYMBOL? e.Re (s.dir e.pos)) e.rest =
     1226    (IF ((SYMBOL? e.Re (<Pos (e.Re) s.dir e.pos>))) e.fail)
     1227    <CC-Deref (e.fail) e.rest>;
     1228  (DEREF t.var e.Re (s.dir e.pos)) e.rest =
     1229    (DEREF t.var e.Re (<Pos (e.Re) s.dir e.pos>))
     1230    <CC-Deref (e.fail) e.rest>;
     1231  /*empty*/ = /*empty*/;
     1232};
     1233
     1234CC-Eqs (e.fail) (e.assigns) e.eqs, {
     1235  e.eqs : ((e.Re) (s.dir e.pos) t.Pt (e.len)) e.rest =
     1236    <Pos (e.Re) s.dir e.pos> :: e.pos,
     1237    {
     1238      \{
     1239        <Get-Var Instantiated? t.Pt> : True =
     1240          {
     1241            <Get-Var Flat? t.Pt> : True = FLAT-EQ;
     1242            EQ;
     1243          };
     1244        t.Pt : \{
     1245          (REF e) = t.Pt;
     1246          (STATIC e) = <Get-Static t.Pt>;
     1247        } :: e.Pt =
     1248          {
     1249            <Flat-Const? e.Pt> = FLAT-EQ;
     1250            EQ;
     1251          };
     1252      } :: s.eq =
     1253        {
     1254          s.eq : FLAT-EQ, <Flat? e.Re> =
     1255            (IF ((NOT (FLAT-EQ (e.Re) (e.pos) (t.Pt) (0) (e.len)))) e.fail);
     1256          (IF ((NOT (EQ (e.Re) (e.pos) (e.len) (t.Pt) (0) (e.len)))) e.fail);
     1257        } :: e.cond,
     1258        {
     1259          e.assigns : $r e1 (SUBEXPR t.Pt e.def) e2 =
     1260            <CC-Eqs (e.fail) (e1 (SUBEXPR t.Pt e.def) e.cond e2)>;
     1261          e.cond <CC-Eqs (e.fail) (e.assigns) e.rest>;
     1262        };
     1263      <Set-Var (Instantiated? True) t.Pt>,
     1264        {
     1265          <Flat? e.Re> = <Set-Var (Flat? True) t.Pt>;;
     1266        },
     1267        <CC-Eqs (e.fail) (e.assigns (SUBEXPR t.Pt e.Re (e.pos) (e.len))) e.rest>;
     1268    };
     1269  e.assigns;
     1270};
     1271
     1272CC-Compose-And-Compare (e.fail) =
     1273  <Update-Hard-Parts> : e,
     1274  {
     1275    <? &Eqs> : v.eqs =
     1276      <CC-Eqs (e.fail) () v.eqs>
     1277      <Store &Eqs /*empty*/>
     1278      <CC-Compose-And-Compare (e.fail)>;;
     1279  };
     1280*       <Compose-Source-For-Compare> : (e.
     1281
     1282*                               {
     1283*                                       <Comp-Cycle e.clashes> :: t.var t.l-var t.r-var e.clashes =
     1284*                                               <Gener-Label L "For" "Cont"> :: t.cont-label,
     1285*                                               <Gener-Label L "For" "Break"> :: t.break-label,
     1286*                                               e.cond e.cond2 e.assigns
     1287*                                               (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
     1288*                                               (LABEL (t.break-label)
     1289*                                                       (FOR (t.cont-label) () ((INC-ITER t.var))
     1290*                                                               <CC (e.clashes) s.tail?
     1291*                                                                       (e.prev-fails (e.fail))
     1292*                                                                       (Comp Fail ((CONTINUE t.cont-label))) e.Snt>
     1293*                                                               (BREAK t.break-label)
     1294*                                                       )
     1295*                                               );
     1296*                                       e.cond e.cond2 e.assigns
     1297*                                       <Comp-Sentence s.tail? (e.prev-fails (e.fail)) () e.Snt>;
     1298*                               };
     1299*               };
     1300*};
     1301
     1302
     1303
    14471304
    14481305
     
    18891746};
    18901747
    1891 Dereference-Subexpr e.clashes =
    1892   e.clashes : e1 (e.t1 Dereference e.t2 (e.Re) (s.dir e.Pe)) e2 \?
    1893   e.Re : (VAR t.name),
    1894   <?? t.name Instantiated> : True,
    1895 //  <WriteLN Dereference!!! t.name <?? t.name Right-checks>>,
    1896 //  <Format e.Pe> : e.f1 t.Ft e.f2 \?
    1897   e.Pe : e.f1 t.Ft e.f2 \?
    1898   \{
    1899     t.Ft : (PAREN e.expr),
    1900       <Length-of e.f1> :: e.pos,
    1901       {
    1902         <?? t.name Left-checks> : e (e.pos (Ref t.ref-name)) e \!
    1903           # \{ <?? t.ref-name Instantiated> : True; } =
    1904           <Declare-Vars "Expr" (VAR t.ref-name)> : e,
    1905           <Instantiate-Vars (VAR t.ref-name)>,
    1906           (Assert (DEREF (VAR t.ref-name) e.Re (e.pos))) :: e.cond,
    1907           (e.t1 Dereference e.t2 (e.Re) (s.dir e.Pe)) :: t.old-clash,
    1908           {
    1909             e.t1 e.t2 : e Without-object-symbols e = Without-object-symbols;
    1910             /*empty*/;
    1911           } :: e.wos,
    1912           (<Gener-Label "clash"> &New-Clash-Tags e.wos
    1913             ((VAR t.ref-name)) (s.dir e.expr)
    1914           ) :: t.new-clash,
    1915           s.dir : {
    1916             LEFT =
    1917               e.cond (e1 t.new-clash t.old-clash e2);
    1918             RIGHT =
    1919               e.cond (e1 t.old-clash t.new-clash e2);
    1920           };
    1921         t.Ft e.f2 : $r e.f3 (PAREN e.expr1) e.f4 \?
    1922           1 <Length-of e.f4> :: e.pos,
    1923           {
    1924             <?? t.name Right-checks> : e (e.pos (Ref t.ref-name)) e \!
    1925               # \{ <?? t.ref-name Instantiated> : True; } =
    1926               <Declare-Vars "Expr" (VAR t.ref-name)> : e,
    1927               <Instantiate-Vars (VAR t.ref-name)>,
    1928               (Assert
    1929                 (DEREF (VAR t.ref-name) e.Re (
    1930                   (INFIX "-" (<Length-of e.Re>) (e.pos))
    1931                 ))
    1932               ) :: e.cond,
    1933               (e.t1 Dereference e.t2 (e.Re) (s.dir e.Pe)) :: t.old-clash,
    1934               {
    1935                 e.t1 e.t2 : e Without-object-symbols e =
    1936                   Without-object-symbols;
    1937                 /*empty*/;
    1938               } :: e.wos,
    1939               (<Gener-Label "clash"> &New-Clash-Tags e.wos
    1940                 ((VAR t.ref-name)) (s.dir e.expr1)
    1941               ) :: t.new-clash,
    1942               s.dir : {
    1943                 RIGHT =
    1944                   e.cond (e1 t.new-clash t.old-clash e2);
    1945                 LEFT =
    1946                   e.cond (e1 t.old-clash t.new-clash e2);
    1947               };
    1948             \!\!\! $fail;
    1949           };
    1950         \!\! $fail;
    1951       };
    1952     e.f2 : /*empty*/ =
    1953       (e1 (e.t1 e.t2 (e.Re) (s.dir e.Pe)) e2);
    1954   };
    1955 
    1956 
    1957 
    1958 $func Deref-Left  (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
    1959   e.Pe (e.conds) (e.assigns) (e.clashes) (e.rest-Pe);
    1960 
    1961 $func Deref-Right (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
    1962   e.Pe (e.conds) (e.assigns) (e.clashes) (e.rest-Pe);
    1963 
    1964 Deref-Exprs (e.fail) (e.conds) (e.assigns) e.clashes, {
    1965   e.clashes : e1 (e.t1 Deref e.t2 (e.Re) (s.dir e.Pe)) e2 =
    1966     <Deref-Left  (e.fail) () () () (0) (e.Re) e.Pe>
    1967       :: e.l-Pe (e.l-conds) (e.l-assigns) (e.l-clashes) (e.rest-Pe),
    1968     <Deref-Right (e.fail) () () () (0) (e.Re) e.rest-Pe>
    1969       :: e.r-Pe (e.r-conds) (e.r-assigns) (e.r-clashes) (e.Pe),
    1970     e1 e.l-clashes (e.t1 e.t2 (e.Re) (s.dir e.l-Pe e.Pe e.r-Pe)) e.r-clashes
    1971     <Deref-Exprs (e.fail)
    1972             (e.conds e.l-conds e.r-conds)
    1973             (e.assigns e.l-assigns e.r-assigns) e2>;
    1974   e.clashes (e.conds) (e.assigns);
    1975 };
    1976 
    1977 Deref-Left (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe, {
    1978   e.Pe : t.Pt e.rest, {
    1979     <Get-Known-Length t.Pt> : e.len (), {
    1980       t.Pt : (PAREN expr) =
    1981         <Gener-Vars ((VAR)) "deref" e.Re> : t.var,
    1982         <Set-Var (Instantiated? True) t.var>,
    1983         (PAREN t.var)
    1984         ((IF ((SYMBOL? e.Re (e.pos))) e.fail))
    1985         ((DEREF t.var e.Re (e.pos)))
    1986         ((<Gener-Label "clash"> &New-Clash-Tags (t.var) (LEFT expr)));
    1987       t.Pt () () ();
    1988     } :: t.Pt (e.cond) (e.assign) (e.clash) =
    1989       t.Pt
    1990       <Deref-Left (e.fail)
    1991             (e.conds e.cond) (e.assigns e.assign) (e.clashes e.clash)
    1992             (e.pos e.len) (e.Re) e.rest>;
    1993     (e.conds) (e.assigns) (e.clashes) (e.Pe);
    1994   };
    1995   (e.conds) (e.assigns) (e.clashes) ();
    1996 };
    1997 
    1998 Deref-Right (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
    1999   () () () (e.Pe);
    2000 
    2001 
    2002 
    2003 $func Compare-Terms-Left  (e.fail) (e.pos) (e.Re) e.Pe = e.cond (e.rest-Pe);
    2004 $func Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = e.cond (e.rest-Pe);
    2005 
    2006 Compare-Subexprs (e.fail) (e.conds) e.clashes, {
    2007   e.clashes : (e.t (e.Re) (s.dir e.Pe)) e.rest =
    2008     <Compare-Terms-Left (e.fail) (0) (e.Re) e.Pe> :: e.l-cond (e.rest-Pe),
    2009     <Compare-Terms-Right (e.fail) (0) (e.Re) e.rest-Pe> :: e.r-cond (e.Pe),
    2010     {
    2011       e.Pe : /*empty*/ = /*empty*/;
    2012       (e.t (e.Re) (s.dir e.Pe));
    2013     } :: e.clash,
    2014     e.clash <Compare-Subexprs (e.fail) (e.conds e.l-cond e.r-cond) e.rest>;
    2015   (e.conds);
    2016 };
    2017 
    2018 Compare-Terms-Left (e.fail) (e.pos) (e.Re) e.Pe, {
    2019   e.Pe : t.Pt e.rest, {
    2020     <Get-Known-Length t.Pt> : e.len (), {
    2021       \{
    2022         <Get-Var Instantiated? t.Pt> : True =
    2023           {
    2024             <Get-Var Flat? t.Pt> : True = FLAT-EQ;
    2025             EQ;
    2026           };
    2027         t.Pt : \{
    2028           (REF e) = t.Pt;
    2029           (STATIC e) = <Get-Static t.Pt>;
    2030         } :: e.Pt =
    2031           {
    2032             <Flat-Const? e.Pt> = FLAT-EQ;
    2033             EQ;
    2034           };
    2035         <Var? t.Pt> =
    2036           <Set-Var (Value (e.Re) (e.pos) (e.len)) t.Pt>,
    2037           $fail;
    2038       } :: s.eq =
    2039         (IF ((NOT (EQ (e.Re) (e.pos) (e.len) (t.Pt) (0) (e.len)))) e.fail);
    2040       /*empty*/;
    2041     } :: e.cond =
    2042       e.cond <Compare-Terms-Left (e.fail) (e.pos e.len) (e.Re) e.rest>;
    2043     (e.Pe);
    2044   };
    2045   ();
    2046 };
    2047 
    2048 Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = (e.Pe);
    2049 
    2050 
    2051 
    2052 Comp-Cycle e.clashes =
    2053   e.clashes : e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2 =
    2054   e.Re : t.var,
    2055   s.dir : {
    2056     LEFT =
    2057       e.Pe : t.var-e1 e.rest,
    2058       <Gener-Vars ((VAR)) "lsplit" e.Re> : t.var-e2,
    2059       <Set-Var (Instantiated? True) t.var-e1>,
    2060       <Set-Var (Instantiated? True) t.var-e2>,
    2061       t.var t.var-e1 t.var-e2
    2062       e1 (<Gener-Label "clash"> &New-Clash-Tags (t.var-e2) (s.dir e.rest)) e2;
    2063   };
    2064 
     1748
     1749
     1750
     1751
     1752$const New-Clash-Tags = Unknown-length Ties Check-symbols Deref Compare;
    20651753
    20661754
     
    23642052
    23652053Comp-Cyclic e.clashes =
    2366   <WriteLN ??? e.clashes>,
    23672054  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 =
    23682055  e.Re : (VAR (e.QualifiedName)),
     
    23932080  s.dir : {
    23942081    LEFT =
    2395       <WriteLN XXXXX e.Cycle>,
    23962082      e.Cycle : t.var-e1 e.rest,
    2397 //!                     t.var-e1 : (VAR (e.SplitName)),
    2398       t.var-e1 : (s (e.SplitName)), //STUB!
     2083      t.var-e1 : (VAR (e.SplitName)),
    23992084      {
    24002085//        e.rest : t.var-e2 = t.var-e2;
     
    25212206
    25222207
    2523 $func Ref-Len t.name = e.length;
    2524 
    2525 /*
    2526  * Из верхнего уровня выражения изымаются все переменные, длина которых не
    2527  * может быть посчитана (она неизвестна из формата, и переменная ещё не
    2528  * получила значение в run-time).  Список этих переменных возвращается вторым
    2529  * параметром.  Первым параметром возвращается длина оставшегося после их
    2530  * изъятия выражения.
    2531  */
    2532 Get-Known-Length e.Re =
    2533   e.Re (/*e.length*/) (/*e.unknown-vars*/) $iter {
    2534     e.Re : t.Rt e.rest, t.Rt : {
    2535       s.ObjectSymbol = 1 ();    // Может появиться из константы.
    2536       (PAREN e) = 1 ();
    2537       (REF t.name) = <Ref-Len t.name> ();
    2538       (STATIC t.name) = <Get-Known-Length <Get-Static t.Rt>>;
    2539       t, <Var? t.Rt>, {
    2540         <Get-Var Length t.Rt> : v.len = v.len ();
    2541         <Get-Var Instantiated? t.Rt> : True = (LENGTH t.Rt) ();
    2542         /*empty*/ (t.Rt);
    2543       };
    2544     } :: e.len (e.var),
    2545       e.rest (e.length e.len) (e.unknown-vars e.var);
    2546   } :: e.Re (e.length) (e.unknown-vars),
    2547   e.Re : /*empty*/ =
    2548   {
    2549     e.length : /*empty*/ = 0 (e.unknown-vars);
    2550     e.length (e.unknown-vars);
    2551   };
    25522208
    25532209Length-of {
     
    25582214        s.ObjectSymbol = 1;     // Может появиться из константы.
    25592215        (PAREN e) = 1;
    2560         (REF t.name) = <Ref-Len t.name>;
     2216        (REF t.name) = ; //<Ref-Len t.name>;  STUB!!!
    25612217        (STATIC t.name) = <Length-of <Get-Static t.Rt>>;
    25622218        t, <Var? t.Rt>, {
     
    25692225    e.Re : /*empty*/ =
    25702226    e.Length;
    2571 };
    2572 
    2573 Ref-Len t.name = {
    2574   <Lookup &Const-Len t.name>;
    2575   <Length-of <Middle 3 0 <Lookup &Const t.name>>> :: e.len =
    2576     <Bind &Const-Len (t.name) (e.len)>,
    2577     e.len;
    2578   1;
    25792227};
    25802228
  • to-imperative/trunk/compiler/rfp_compile.rfi

    r683 r759  
    2626$func Ref-To-Var e.Snt = e.Snt;
    2727
     28
     29
  • to-imperative/trunk/compiler/rfp_helper.rf

    r683 r759  
    9292};
    9393
     94
     95
     96L- s1 e2 = <L s1 e2>;
     97
     98R- s1 e2 = <R s1 e2>;
     99
  • to-imperative/trunk/compiler/rfp_helper.rfi

    r683 r759  
    3030$func Repeat s.num expr = expr;
    3131
     32
     33$func? L- e = e;
     34
     35$func? R- e = e;
     36
  • to-imperative/trunk/compiler/rfp_vars.rf

    r744 r759  
    117117    e.info : e (Length e) e = e.info;
    118118    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  /*
     122   * Если переменная получила значение, а длина её не была известна, значит
     123   * она будет считаться функцией LENGTH в ран-тайм.
     124   */
     125  {
     126    e.info : e (Length e) e = e.info;
     127    e.info : e (Instantiated? True) e = e.info (Length (LENGTH t.var));
     128    e.info;
     129  } :: e.info,
     130  /*
     131   * s-переменные помечаем как плоские.
     132   */
     133  {
     134    t.var : (SVAR e) =
     135      {
     136        e.info : e (Flat? e) e = e.info;
     137        e.info (Flat? True);
     138      };
    119139    e.info;
    120140  } :: e.info,
     
    144164  };
    145165
    146 Ref-Set-Var e.info t.var = <Set-Var e.info t.var>;
     166Set-Var- e.info t.var = <Set-Var e.info t.var>;
    147167
    148168
  • to-imperative/trunk/compiler/rfp_vars.rfi

    r712 r759  
    33// $Date$
    44
    5 $func? Var? term = ;
     5$func? Var? expr = ;
    66$func Set-Var e.info t.var = ;
    77$func? Get-Var t.key t.var = e.val;
    8 $func Ref-Set-Var e = e;
     8$func Set-Var- e = e;
    99
    1010$func Vars-Copy-State = t.vars;
Note: See TracChangeset for help on using the changeset viewer.