Changeset 2034 for to-imperative/trunk/compiler/rfp_as2as.rf

Timestamp:

Jul 27, 2006, 8:40:44 AM (14 years ago)

Author:

orlov

Message:

• Proper generation of debug info for use with Debug library (-dbg option).
• Result expressions can contain blocks.

File:

• to-imperative/trunk/compiler/rfp_as2as.rf (modified) (7 diffs)

to-imperative/trunk/compiler/rfp_as2as.rf

@@ -8 +8 @@
 $use "rfp_helper";
 $use "rfp_vars";
+$use "rfp_debug";
 
 $use Arithm Class List StdIO Table;
@@ -16 +17 @@
 // transform { A; } : Pe into { A; } :: aux, aux : Pe
 $func Unstick-Blocks e.Sentence = e.Sentence (e.Fe);
+
+// remove blocks from Re
+$func Flatten-Result s.N (e.Re) e.items = e.assigns s.N (e.Re);
 
 $func Generate-In-Vars (e.in) e.branch = (e.in) e.branch;
@@ -50 +54 @@
     },
       t.item : (s.link s.tag t.pragma t.name (e.in) (e.out) (BRANCH t.p e.branch)) =
-      <Unstick-Blocks e.branch> :: e.branch t,
       {
         <Format-Exp e.in> : e.in =
@@ -56 +59 @@
         (e.in) e.branch;
       } :: (e.in) e.branch,
+      {
+        <In-Table? &RFP-Options DBG> =
+          <Add-Debug (RESULT t.p e.in) e.branch>;
+        e.branch;
+      } :: e.branch,
+      <Unstick-Blocks e.branch> :: e.branch t,
       <Rename-Vars 0 (<Vars e.in>) () e.branch> :: e.branch,
       (s.link s.tag t.pragma t.name (e.in) (e.out) (BRANCH t.p e.branch));
@@ -92 +101 @@
       } =
         <Gener-Var-Indices 1 (<MSG e.Fes>) "aux" "block"> :: e.aux s,
-        eL (s.block t.Pragma e.br) (FORMAT e.aux)
-        (RESULT e.aux) <Unstick-Blocks eR>;
+        eL (s.block t.Pragma e.br) (FORMAT (PRAGMA) e.aux)
+        (RESULT (PRAGMA) e.aux) <Unstick-Blocks eR>;
       eR : /*empty*/ =
         eL (s.block t.Pragma e.br) (<MSG e.Fes>);
       eL (s.block t.Pragma e.br) <Unstick-Blocks eR>;
     };
-  (RESULT t.Pragma e.Re) =
-    eL (RESULT t.Pragma e.Re) (<Format-Exp e.Re>);
+  (RESULT t.Pragma e.Re) eR =
+    <Flatten-Result 1 () e.Re> :: e.assigns s (e.Re),
+    {
+      eR : v =
+        eL e.assigns (RESULT t.Pragma e.Re) <Unstick-Blocks eR>;
+      eL e.assigns (RESULT t.Pragma e.Re) (<Format-Exp e.Re>);
+    };
   (ITER (BRANCH t.p1 e.body) t.IterVars (BRANCH t.p2 e.condition)) =
     <Unstick-Blocks e.body> :: e.body t,
@@ -113 +127 @@
     eL (ERROR t.Pragma) eR (FAIL);
 };
+
+Flatten-Result s.N (e.Re) e.items, e.items : {
+  t1 e.rest, t1 : \{ (BLOCK e); (BLOCK? e); } =
+    <Gener-Var-Indices s.N (<Format-Exp e.Re>) "aux" "result"> :: e.aux1 s.N,
+    <Unstick-Blocks t1> :: e1 (e.Format),
+    <Gener-Var-Indices s.N (e.Format) "aux" "block"> :: e.aux2 s.N,
+    (RESULT (PRAGMA) e.Re) (FORMAT (PRAGMA) e.aux1)
+    e1 (FORMAT (PRAGMA) e.aux2)
+    <Flatten-Result s.N (e.aux1 e.aux2) e.rest>;
+  (PAREN e.r) e.rest =
+    <Flatten-Result s.N () e.r> :: e.assigns s.N (e.r),
+    e.assigns <Flatten-Result s.N (e.Re (PAREN e.r)) e.rest>;
+  (CALL t.p t.name e.r) e.rest =
+    <Flatten-Result s.N () e.r> :: e.assigns s.N (e.r),
+    e.assigns <Flatten-Result s.N (e.Re (CALL t.p t.name e.r)) e.rest>;
+  t1 e.rest = <Flatten-Result s.N (e.Re t1) e.rest>;
+  /*empty*/ = s.N (e.Re);
+};
+
 
 /*
@@ -301 +334 @@
 
 
-/////////////////////////// Varibles Using Analysis /////////////////////////
+/////////////////////////// Variables Using Analysis /////////////////////////
 //
 //$func Post-Comp (e.used-vars) e.comp-func = (e.used-vars) e.result-func;