Ignore:
Timestamp:
May 21, 2003, 4:43:54 PM (18 years ago)
Author:
orlov
Message:
  • Work towards clashes compilation.
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r725 r744  
    257257//!     <Norm-Vars (<Vars e.in>) e.Sentence> :: (e.arg-vars) e.Sentence,
    258258//!     <Declare-Vars Expr e.arg-vars> : e,
    259   <Vars <Gener-Vars (e.in) "arg">> :: e.arg-vars,
    260   <Vars-Decl e.arg-vars> : e,
     259  <Vars e.in> :: e.arg-vars,
     260  <Map &Ref-Set-Var (Instantiated? True) (e.arg-vars)> : e,
     261*       <Vars-Decl e.arg-vars> : e,
    261262*       <Instantiate-Vars e.arg-vars>,
    262263  <Store &Last-Re /*empty*/>,
    … …  
    615616      :: e.comp-negation,
    616617//    <Pop-Snt-State>,
    617     (LABEL (t.label) e.comp-negation)   <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     618    (LABEL (t.label) e.comp-negation) <Comp-Sentence s.tail? (v.fails) () e.Snt>;
    618619
    619620//  (Comp Verbatim expr) = expr;
    … …  
    633634
    634635//  (Comp Retfail) = RETFAIL;
     636
     637  (Comp Fail t.fail) e.Snt = <Comp-Sentence s.tail? (v.fails t.fail) () e.Snt>;
    635638
    636639};
    … …  
    682685    <Gener-Vars (e.Fout) e.prefix> :: /*(e.vars)*/ e.Re,
    683686    <Vars e.Re> :: e.vars,
    684 *               <Instantiate-Vars e.vars>,
     687    <Map &Ref-Set-Var (Instantiated? True) (e.vars)> : e,
    685688    {
    686689      s.tag : FUNC? =   (Failable (CALL t.name (e.splited-Re) (e.vars)));
    … …  
    739742        {
    740743          e.Re : e1 t2 e3, <Static-Term? t2> : Dynamic t.dyn-Rt =
    741             <Static-Expr? Create e.Re> :: s e.Re,
    742             Dynamic <Create-Static t.Rt e1> t.dyn-Rt e.Re;
     744            <Static-Expr? Create e3> :: s e3,
     745            Dynamic <Create-Static t.Rt e1> t.dyn-Rt e3;
    743746          {
    744747            s.create? : Create = Static <Create-Static t.Rt e.Re>;
    … …  
    770773$func Comp-Assign-to-Var e = e;
    771774
    772 Comp-Assign-to-Var (t.var (e.Re)), {
    773   t.var : e.Re = /*empty*/;
    774   <Generated-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
    775   <Get-Var Decl t.var> : s = (ASSIGN <Vars-Print t.var> e.Re);
    776   <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
    777 };
     775Comp-Assign-to-Var (t.var (e.Re)) =
     776  <Set-Var (Instantiated? True) t.var>,
     777  {
     778    t.var : e.Re = /*empty*/;
     779    <Generated-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
     780    <Get-Var Decl t.var> : s = (ASSIGN <Vars-Print t.var> e.Re);
     781    <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
     782  };
    778783
    779784Comp-Assigns e.assigns = <Map &Comp-Assign-to-Var (e.assigns)>;
    … …  
    12701275$func Get-Known-Length e.expr = e.length-of-known-part (e.unknown-vars);
    12711276
     1277$func Cyclic-Restr (e.fail) (e.watched-clashes) e.clashes = e.cond (e.clashes);
     1278
    12721279$func Compare-Subexprs (e.fail) e.clashes = e.cond;
     1280
     1281$func? Comp-Cycle e.clashes = t t t e.clashes;
    12731282
    12741283$func Assign-Value e = e;
    … …  
    12891298          s.tail? (e.prev-fails (e.fail)) e.Snt>;
    12901299      /*
    1291        * Если неизвестная переменная во всём клэше ровно одна, и она
     1300       * Если неизвестная переменная во всём клеше ровно одна, и она
    12921301       * входит в левую и правую части разное кол-во раз, то её длину
    12931302       * можно вычислить.
     1303       *
     1304       * Если же она входит в левую и правую части одинаковое кол-во раз,
     1305       * то остальные составляющие клеша проверяются на равенство, и он
     1306       * объявляется циклическим до вычисления этой переменной.
    12941307       */
    1295       <"-" <Length e.vars-Re> <Length e.vars-Pe>> :: s.diff,
    1296         <"/=" (s.diff) (0)>,
    1297         <Nub e.vars-Re e.vars-Pe> : t.var =
    1298         {
    1299           <"<" (s.diff) (0)> =
    1300             <"*" s.diff -1> (INFIX "-" (e.len-Re) (e.len-Pe));
    1301           s.diff (INFIX "-" (e.len-Pe) (e.len-Re));
    1302         } :: s.mult e.diff,
    1303         <Create-Int-Var ("len_") t.var e.diff> :: t.len-var e.len-assign,
    1304         <Set-Var (Length (INFIX "/" (t.var) (s.mult))) t.len-var>,
    1305         {
    1306           <Get-Var Max t.var> : v.max =
    1307             ((INFIX ">" (t.len-var) ((INFIX "*" (s.mult) (v.max)))));
    1308           /*empty*/;
    1309         } :: e.max-cond,
    1310         <Get-Var Min t.var> : {
    1311           0 = /*empty*/;
    1312           e.min = ((INFIX "<" (t.len-var) ((INFIX "*" (s.mult) (e.min)))));
    1313         } :: e.min-cond,
    1314         e.len-assign
    1315         (IF ((INFIX "||"
    1316             e.max-cond e.min-cond ((INFIX "%" (t.len-var) (s.mult)))
    1317           ))
    1318           e.fail)
    1319         <CC (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2)
    1320           s.tail? (e.prev-fails (e.fail)) e.Snt>;
     1308      <Nub e.vars-Re e.vars-Pe> : t.var, {
     1309        <"-" <Length e.vars-Re> <Length e.vars-Pe>> :: s.diff,
     1310          <"/=" (s.diff) (0)> =
     1311          {
     1312            <"<" (s.diff) (0)> = <"*" s.diff -1> (e.len-Re) (e.len-Pe);
     1313            s.diff (e.len-Pe) (e.len-Re);
     1314          } :: s.mult (e.minuend) (e.subtrahend),
     1315          <Create-Int-Var ("len") Aux e.minuend> :: t.m-var e.m-assign,
     1316          <Create-Int-Var ("len") Aux e.subtrahend> :: t.s-var e.s-assign,
     1317          <Get-Var Min t.var> :: e.min,
     1318          ((INFIX "<" (t.m-var)
     1319                ((INFIX "+" (t.s-var)
     1320                      ((INFIX "*" (e.min) (s.mult)))
     1321          ))                    )) :: e.min-cond,
     1322          <Get-Var Max t.var> : {
     1323            /*empty*/;
     1324            e.max =
     1325              ((INFIX ">" (t.m-var)
     1326                    ((INFIX "+" (t.s-var)
     1327                          ((INFIX "*" (e.max) (s.mult)))
     1328              ))                        ));
     1329          } :: e.max-cond,
     1330          (INFIX "%" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult)) :: e.div-cond,
     1331          <Create-Int-Var ("len_") t.var
     1332            (INFIX "/" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult))
     1333          > :: t.len-var e.len-assign,
     1334          <Set-Var (Length t.len-var) t.var>,
     1335          e.m-assign e.s-assign
     1336          (IF ((INFIX "||" e.min-cond e.max-cond)) e.fail)
     1337          (IF (e.div-cond) e.fail)
     1338          e.len-assign
     1339          <CC (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2)
     1340            s.tail? (e.prev-fails (e.fail)) e.Snt>;
     1341
     1342        (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
     1343          <CC (e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2)
     1344            s.tail? (e.prev-fails (e.fail)) e.Snt>;
     1345      };
    13211346    };
    13221347
    13231348  /*
    1324    * If previous doesn't work then compare recursively all known
    1325    * subexpressions and all unknown repeated subexpressions with
    1326    * corresponding parts of source.
     1349   * Перебрали все клеши, из которых можно было вычислить что-то определённое
     1350   * про длины.
     1351   *
     1352   * Теперь выпишем неравенства на длины, накладываемые остальными клешами.
    13271353   */
    1328   <Compare-Subexprs (e.fail) e.clashes> :: e.cond,
     1354  <Cyclic-Restr (e.fail) (/*e.watched*/) e.clashes> :: e.cond (e.clashes),
     1355
     1356    /*
     1357     * If previous doesn't work then compare recursively all known
     1358     * subexpressions and all unknown repeated subexpressions with
     1359     * corresponding parts of source.
     1360     */
     1361    e.cond <Compare-Subexprs (e.fail) e.clashes> :: e.cond,
    13291362    e.clashes (/*e.assigns*/) $iter {
    1330       e.clashes : (e (e.Re) (s.dir e.Pe)) e.rest =
     1363      e.tmp-clashes : (e (e.Re) (s.dir e.Pe)) e.rest =
    13311364        e.rest (e.assigns <Map &Assign-Value (<Vars e.Pe>)>);
    1332     } :: e.clashes (e.assigns),
    1333     e.clashes : /*empty*/ =
    1334     e.cond e.assigns <Comp-Sentence s.tail? (e.prev-fails (e.fail)) () e.Snt>;
     1365    } :: e.tmp-clashes (e.assigns),
     1366    e.tmp-clashes : /*empty*/ =
     1367    {
     1368      <Comp-Cycle e.clashes> :: t.var t.l-var t.r-var e.clashes =
     1369        <Gener-Label L "For" "Cont"> :: t.cont-label,
     1370        <Gener-Label L "For" "Break"> :: t.break-label,
     1371        e.cond e.assigns
     1372        (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
     1373//        (LABEL (t.break-label)
     1374          (FOR (t.cont-label) () ((INC-ITER t.var))
     1375            <CC (e.clashes) s.tail?
     1376              (e.prev-fails (e.fail) /*((BREAK t.break-label))*/)
     1377              (Comp Fail ((CONTINUE t.cont-label))) e.Snt>
     1378//          )
     1379        );
     1380      e.cond e.assigns <Comp-Sentence s.tail? (e.prev-fails (e.fail)) () e.Snt>;
     1381    };
    13351382};
     1383
     1384
    13361385
    13371386Assign-Value t.var =
    … …  
    13411390    /*empty*/;
    13421391  };
     1392
     1393
     1394
     1395$func  Get-Min e = e;
     1396
     1397$func? Get-Max e = e;
     1398
     1399Cyclic-Restr (e.fail) (e.watched) e.clashes, {
     1400  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2,
     1401    <Get-Known-Length e.Re> :: e.len-Re (e.vars-Re),
     1402    <Get-Known-Length e.Pe> :: e.len-Pe (e.vars-Pe),
     1403    {
     1404      <Get-Max e.vars-Re> :: e.max =
     1405        <Create-Int-Var ("lmax") Aux e.len-Re e.max> :: t.max-Re e.assign1,
     1406        <Get-Min e.vars-Pe> :: e.min,
     1407        <Create-Int-Var ("rmin") Aux e.len-Pe e.min> :: t.min-Pe e.assign2,
     1408        (e.assign1 e.assign2) ((INFIX "<" (t.max-Re) (t.min-Pe)));
     1409      () /*empty*/;
     1410    } :: (e.ass1) e.cond1,
     1411    {
     1412      <Get-Max e.vars-Pe> :: e.max =
     1413        <Create-Int-Var ("rmax") Aux e.len-Pe e.max> :: t.max-Pe e.assign1,
     1414        <Get-Min e.vars-Re> :: e.min,
     1415        <Create-Int-Var ("lmin") Aux e.len-Re e.min> :: t.min-Re e.assign2,
     1416        (e.assign1 e.assign2) ((INFIX ">" (t.min-Re) (t.max-Pe)));
     1417      () /*empty*/;
     1418    } :: (e.ass2) e.cond2,
     1419    {
     1420      e.cond1 : /*empty*/, e.cond2 : /*empty*/ = /*empty*/;
     1421      e.ass1 e.ass2 (IF ((INFIX "||" e.cond1 e.cond2)) e.fail);
     1422    } :: e.cond,
     1423    e.cond
     1424    <Cyclic-Restr (e.fail) (e.watched e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe))) e2>;
     1425  (e.watched e.clashes);
     1426};
     1427
     1428Get-Min
     1429{
     1430  t.var e.vars = <Get-Var Min t.var> <Get-Min e.vars>;
     1431  /*empty*/ = /*empty*/;
     1432};
     1433
     1434Get-Max
     1435{
     1436  t.var e.vars = <Get-Var Max t.var> : v.max, v.max <Get-Max e.vars>;
     1437  /*empty*/ = /*empty*/;
     1438};
    13431439
    13441440
    … …  
    18941990
    18951991Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = ();
     1992
     1993
     1994
     1995Comp-Cycle e.clashes =
     1996  e.clashes : e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2 =
     1997  e.Re : t.var,
     1998  s.dir : {
     1999    LEFT =
     2000      e.Pe : t.var-e1 e.rest,
     2001      <Gener-Vars ((VAR)) "lsplit" e.Re> : t.var-e2,
     2002      <Set-Var (Instantiated? True) t.var-e1>,
     2003      <Set-Var (Instantiated? True) t.var-e2>,
     2004      t.var t.var-e1 t.var-e2
     2005      e1 (<Gener-Label "clash"> &New-Clash-Tags (t.var-e2) (s.dir e.rest)) e2;
     2006  };
    18962007
    18972008
    … …  
    21752286  e.compose (e.not-inst) s.flat?;
    21762287
     2288Get-Subexprs e.vars =
     2289//  <WriteLN Get-Subexprs e.vars>,
     2290  e.vars () $iter {
     2291    e.vars : (VAR t.name) e.rest,
     2292      # \{ <?? t.name Instantiated> : True; },
     2293      <?? t.name Left-compare> : (t.var s.dir (e.pos) (0) e.len) e =
     2294      <Instantiate-Vars (VAR t.name)>,
     2295      <Declare-Vars "Expr" (VAR t.name)> : e,
     2296      {
     2297        s.dir : Right =
     2298          (INFIX "-" (<Length-of t.var>) (e.pos e.len));
     2299        e.pos;
     2300      } :: e.pos,
     2301      e.rest (e.decls (Used t.var) (SUBEXPR (VAR t.name) t.var (e.pos) (e.len)));
     2302    // STUB:
     2303    e.vars : t e.rest = e.rest (e.decls);
     2304  } :: e.vars (e.decls),
     2305  e.vars : /*empty*/ =
     2306  e.decls;
     2307
    21772308Comp-Cyclic e.clashes =
    21782309  <WriteLN ??? e.clashes>,
    … …  
    22522383  };
    22532384
    2254 Get-Subexprs e.vars =
    2255 //  <WriteLN Get-Subexprs e.vars>,
    2256   e.vars () $iter {
    2257     e.vars : (VAR t.name) e.rest,
    2258       # \{ <?? t.name Instantiated> : True; },
    2259       <?? t.name Left-compare> : (t.var s.dir (e.pos) (0) e.len) e =
    2260       <Instantiate-Vars (VAR t.name)>,
    2261       <Declare-Vars "Expr" (VAR t.name)> : e,
    2262       {
    2263         s.dir : Right =
    2264           (INFIX "-" (<Length-of t.var>) (e.pos e.len));
    2265         e.pos;
    2266       } :: e.pos,
    2267       e.rest (e.decls (Used t.var) (SUBEXPR (VAR t.name) t.var (e.pos) (e.len)));
    2268     // STUB:
    2269     e.vars : t e.rest = e.rest (e.decls);
    2270   } :: e.vars (e.decls),
    2271   e.vars : /*empty*/ =
    2272   e.decls;
    2273 
    22742385Split-Hard-Left e.expr =
    22752386  e.expr () $iter {
Note: See TracChangeset for help on using the changeset viewer.