Changeset 750 for to-imperative/trunk/compiler/rfp_compile.rf

Timestamp:

May 22, 2003, 1:41:13 PM (18 years ago)

Author:

orlov

Message:

• Work towards clashes compilation.

File:

• to-imperative/trunk/compiler/rfp_compile.rf (modified) (5 diffs)

to-imperative/trunk/compiler/rfp_compile.rf

@@ -1256 +1256 @@
 $func CC (e.clashes) s.tail? (v.fails) e.Snt = e.asail-Snt;
 
-$const New-Clash-Tags = Unknown-length Ties Check-symbols Dereference Compare;
+$const New-Clash-Tags = Unknown-length Ties Check-symbols Deref Compare;
 
 Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence =
@@ -1277 +1277 @@
 $func Cyclic-Restr (e.fail) (e.watched-clashes) e.clashes = e.cond (e.clashes);
 
-$func Compare-Subexprs (e.fail) e.clashes = e.cond;
+$func Deref-Exprs
+    (e.fail) (e.conds) (e.assigns) e.clashes = e.clashes (e.conds) (e.assigns);
+
+$func Compare-Subexprs (e.fail) (e.conds) e.clashes = e.clashes (e.conds);
 
 $func? Comp-Cycle e.clashes = t t t e.clashes;
@@ -1354 +1357 @@
   <Cyclic-Restr (e.fail) (/*e.watched*/) e.clashes> :: e.cond (e.clashes),
 
-    /*
-     * If previous doesn't work then compare recursively all known
-     * subexpressions and all unknown repeated subexpressions with
-     * corresponding parts of source.
-     */
-    e.cond <Compare-Subexprs (e.fail) e.clashes> :: e.cond,
-    e.clashes (/*e.assigns*/) $iter {
-      e.tmp-clashes : (e (e.Re) (s.dir e.Pe)) e.rest =
-        e.rest (e.assigns <Map &Assign-Value (<Vars e.Pe>)>);
-    } :: e.tmp-clashes (e.assigns),
-    e.tmp-clashes : /*empty*/ =
-    {
-      <Comp-Cycle e.clashes> :: t.var t.l-var t.r-var e.clashes =
-        <Gener-Label L "For" "Cont"> :: t.cont-label,
-        <Gener-Label L "For" "Break"> :: t.break-label,
-        e.cond e.assigns
-        (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
-//        (LABEL (t.break-label)
-          (FOR (t.cont-label) () ((INC-ITER t.var))
-            <CC (e.clashes) s.tail?
-              (e.prev-fails (e.fail) /*((BREAK t.break-label))*/)
-              (Comp Fail ((CONTINUE t.cont-label))) e.Snt>
-//          )
-        );
-      e.cond e.assigns <Comp-Sentence s.tail? (e.prev-fails (e.fail)) () e.Snt>;
+    <Deref-Exprs (e.fail) (/*e.conds*/) (/*e.assigns*/) e.clashes> : {
+      e.new-clashes (v.conds) (v.assigns) =
+        e.cond v.conds v.assigns
+        <CC (e.new-clashes) s.tail? (e.prev-fails (e.fail)) e.Snt>;
+
+      /*
+       * If previous doesn't work then compare recursively all known
+       * subexpressions and all unknown repeated subexpressions with
+       * corresponding parts of source.
+       */
+      e.new-clashes () () =
+        <Compare-Subexprs (e.fail) () e.new-clashes> :: e.clashes (e.cond2),
+        e.new-clashes (/*e.assigns*/) $iter {
+          e.new-clashes : (e (e.Re) (s.dir e.Pe)) e.rest =
+            e.rest (e.assigns <Map &Assign-Value (<Vars e.Pe>)>);
+        } :: e.new-clashes (e.assigns),
+        e.new-clashes : /*empty*/ =
+        {
+          <Comp-Cycle e.clashes> :: t.var t.l-var t.r-var e.clashes =
+            <Gener-Label L "For" "Cont"> :: t.cont-label,
+            <Gener-Label L "For" "Break"> :: t.break-label,
+            e.cond e.cond2 e.assigns
+            (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
+            (LABEL (t.break-label)
+              (FOR (t.cont-label) () ((INC-ITER t.var))
+                <CC (e.clashes) s.tail?
+                  (e.prev-fails (e.fail))
+                  (Comp Fail ((CONTINUE t.cont-label))) e.Snt>
+                (BREAK t.break-label)
+              )
+            );
+          e.cond e.cond2 e.assigns
+          <Comp-Sentence s.tail? (e.prev-fails (e.fail)) () e.Snt>;
+        };
     };
 };
@@ -1944 +1956 @@
 
 
+$func Deref-Left  (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
+  e.Pe (e.conds) (e.assigns) (e.clashes) (e.rest-Pe);
+
+$func Deref-Right (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
+  e.Pe (e.conds) (e.assigns) (e.clashes) (e.rest-Pe);
+
+Deref-Exprs (e.fail) (e.conds) (e.assigns) e.clashes, {
+  e.clashes : e1 (e.t1 Deref e.t2 (e.Re) (s.dir e.Pe)) e2 =
+    <Deref-Left  (e.fail) () () () (0) (e.Re) e.Pe>
+      :: e.l-Pe (e.l-conds) (e.l-assigns) (e.l-clashes) (e.rest-Pe),
+    <Deref-Right (e.fail) () () () (0) (e.Re) e.rest-Pe>
+      :: e.r-Pe (e.r-conds) (e.r-assigns) (e.r-clashes) (e.Pe),
+    e1 e.l-clashes (e.t1 e.t2 (e.Re) (s.dir e.l-Pe e.Pe e.r-Pe)) e.r-clashes
+    <Deref-Exprs (e.fail)
+            (e.conds e.l-conds e.r-conds)
+            (e.assigns e.l-assigns e.r-assigns) e2>;
+  e.clashes (e.conds) (e.assigns);
+};
+
+Deref-Left (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe, {
+  e.Pe : t.Pt e.rest, {
+    <Get-Known-Length t.Pt> : e.len (), {
+      t.Pt : (PAREN expr) = 
+        <Gener-Vars ((VAR)) "deref" e.Re> : t.var,
+        <Set-Var (Instantiated? True) t.var>,
+        (PAREN t.var)
+        ((IF ((SYMBOL? e.Re (e.pos))) e.fail))
+        ((DEREF t.var e.Re (e.pos)))
+        ((<Gener-Label "clash"> &New-Clash-Tags (t.var) (LEFT expr)));
+      t.Pt () () ();
+    } :: t.Pt (e.cond) (e.assign) (e.clash) =
+      t.Pt
+      <Deref-Left (e.fail)
+            (e.conds e.cond) (e.assigns e.assign) (e.clashes e.clash)
+            (e.pos e.len) (e.Re) e.rest>;
+    (e.conds) (e.assigns) (e.clashes) (e.Pe);
+  };
+  (e.conds) (e.assigns) (e.clashes) ();
+};
+
+Deref-Right (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
+  () () () (e.Pe);
+
+
+
 $func Compare-Terms-Left  (e.fail) (e.pos) (e.Re) e.Pe = e.cond (e.rest-Pe);
 $func Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = e.cond (e.rest-Pe);
 
-Compare-Subexprs (e.fail) e.clashes, {
+Compare-Subexprs (e.fail) (e.conds) e.clashes, {
   e.clashes : (e.t (e.Re) (s.dir e.Pe)) e.rest =
-    <Compare-Terms-Left (e.fail) (0) (e.Re) e.Pe> :: e.left-cond (e.rest-Pe),
-    <Compare-Terms-Right (e.fail) (0) (e.Re) e.rest-Pe> :: e.right-cond t,
-    e.left-cond e.right-cond <Compare-Subexprs (e.fail) e.rest>;
-  /*empty*/;
+    <Compare-Terms-Left (e.fail) (0) (e.Re) e.Pe> :: e.l-cond (e.rest-Pe),
+    <Compare-Terms-Right (e.fail) (0) (e.Re) e.rest-Pe> :: e.r-cond (e.Pe),
+    {
+      e.Pe : /*empty*/ = /*empty*/;
+      (e.t (e.Re) (s.dir e.Pe));
+    } :: e.clash,
+    e.clash <Compare-Subexprs (e.fail) (e.conds e.l-cond e.r-cond) e.rest>;
+  (e.conds);
 };
 
@@ -1985 +2046 @@
 };
 
-Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = ();
+Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = (e.Pe);