source: to-imperative/trunk/compiler/rfp_format.rf @ 1706

Last change on this file since 1706 was 1706, checked in by orlov, 16 years ago
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.8 KB
Line 
1// $Source$
2// $Revision: 1706 $
3// $Date: 2005-02-02 12:12:33 +0000 (Wed, 02 Feb 2005) $
4
5$use Access List StdIO Table;
6
7$use "rfp_compile";
8$use "rfp_vars";
9
10$func Split-Rt t.Ft t.Rt = e.splited-Rt;
11
12//$func MSG-Exprs (e.Fe1) e.Fe2 = e.Fe;
13$func MSG-Exprs e = e;
14
15$func MSG-Terms t.Ft1 t.Ft2 = t.Ft;
16
17// is t.name a $const'ant with an empty value?
18$func? Empty-Const? t.name = ;
19
20// is e.expr an empty expression with regard of $const'ant values?
21$func? Empty-Expr? e.expr = ;
22
23// if in the end the value of $const'ant t.name is term then return that term
24$func? Get-Const-Term t.name = term;
25
26// if expr becomes term after unfolding all $const'ants then return that term
27$func? Get-Term expr = term;
28
29
30/*
31 * Returns format of given result or hard expression or pattern.
32 */
33Format-Exp
34//e1 = <WriteLN Format-Exp e1>, e1 :
35{
36  t.first e.rest, t.first :
37    {
38      s.ObjectSymbol = s.ObjectSymbol;
39      (REF t.Name) = {
40        <In-Table? &Const t.Name> = (REF t.Name);
41        (SVAR);
42      };
43      (CALL t.Fname e), // Is needed anywhere ???
44        <L 4 <Lookup-Func t.Fname>> : (e.FOut) = e.FOut;
45      (CALL t.Pragma t.Fname e) =
46        <L 4 <Lookup-Func t.Fname>> : (e.FOut) = e.FOut;
47      // (BLOCK e.Branches) = ...
48      (PAREN e.Expression) = (PAREN <Format-Exp e.Expression>);
49      (VAR t.name) = $fail;
50      (s.VariableTag e) = (s.VariableTag); // s.VariableTag ::= SVAR | TVAR
51    } :: e.first-format =          //         | VVAR | EVAR
52    e.first-format <Format-Exp e.rest>;
53  = ;
54};
55
56/*
57 * Split-Re (e.Format) e.Re
58 * Returns (e.1) (e.2) ... (e.n) where each e.i is a part of e.Re
59 * corresponded to a variable in e.Format.
60 */
61Split-Re /*(e1) e2, <WriteLN Split-Re (e1) e2>, (e1) e2 :*/ {
62  (t.Ft e.Fe) t.Rt e.Re,
63    \{
64      /*
65       * If the term isn't ve-variable or $const then split it out with Split-Rt.
66       */
67      # \{
68        t.Ft : \{ (VVAR); (EVAR); (REF e); };
69        <Format-Exp t.Rt> : (REF e);
70      } =
71        <Split-Rt t.Ft t.Rt> <Split-Re (e.Fe) e.Re>;
72    };
73  (v.Fe t.Ft) e.Re t.Rt,
74    \{
75      /*
76       * If the term isn't ve-variable or $const then split it out with Split-Rt.
77       */
78      # \{
79        t.Ft : \{ (VVAR); (EVAR); (REF e); };
80        <Format-Exp t.Rt> : (REF e);
81      } =
82        <Split-Re (v.Fe) e.Re> <Split-Rt t.Ft t.Rt>;
83    };
84  ((REF t.name) e.Fe) e.Re, {
85    e.Re : t.Rt e.Rest, <Format-Exp t.Rt> : (REF t.name) = <Split-Re (e.Fe) e.Rest>;
86    <Split-Re (<Middle 3 0 <Lookup &Const t.name>> e.Fe) e.Re>;
87  };
88  (v.Fe (REF t.name)) e.Re, {
89    e.Re : e.Rest t.Rt, <Format-Exp t.Rt> : (REF t.name) = <Split-Re (v.Fe) e.Rest>;
90    <Split-Re (v.Fe <Middle 3 0 <Lookup &Const t.name>>) e.Re>;
91  };
92  ((VVAR)) e.Re = (e.Re);
93  ((EVAR)) e.Re = (e.Re);
94  (e.Fe) t.Rt e.Re, <Format-Exp t.Rt> : (REF t.name) =
95    <Split-Re (e.Fe) <Middle 3 0 <Lookup &Const t.name>> e.Re>;
96  (e.Fe) v.Re t.Rt, <Format-Exp t.Rt> : (REF t.name) =
97    <Split-Re (e.Fe) v.Re <Middle 3 0 <Lookup &Const t.name>>>;
98  () /*empty*/ = /*empty*/;
99};
100
101Split-Rt t.Ft t.Rt/*, <WriteLN Split-Rt t.Ft t.Rt>*/ =
102  t.Ft : {
103    s.ObjectSymbol = /*empty*/;
104    (PAREN e.Fe) = t.Rt : (PAREN e.Re), <Split-Re (e.Fe) e.Re>;
105    t.VariableTag = (t.Rt); // t.VariableTag ::= (TVAR) | (SVAR)
106  };
107
108MSG {
109  exprs (e.Fe) = <Foldr &MSG-Exprs (e.Fe) (exprs)>;
110  /*empty*/ = /*empty*/;
111};
112
113/*
114 * MSG-Exprs (e.Format1) e.Format2
115 * Return e.Format3 -- most specific generalizing of formats 1 and 2.
116 */
117MSG-Exprs {
118  (t.Ft1 e.Fe1) t.Ft2 e.Fe2 \?
119    /*
120     * IF both t.Ft1 and t.Ft2 are hard terms and aren't $const'ants then
121     * split them out with MSG-Terms.
122     */
123    {
124      t.Ft1 : \{ (EVAR); (VVAR); (REF e); } \! $fail;
125      t.Ft2 : \{ (EVAR); (VVAR); (REF e); } \! $fail;
126      <MSG-Terms t.Ft1 t.Ft2> <MSG-Exprs (e.Fe1) e.Fe2>;
127    };
128  (e.Fe1 t.Ft1) e.Fe2 t.Ft2 \?
129    /*
130     * IF both t.Ft1 and t.Ft2 are hard terms and aren't $const'ants then
131     * split them out with MSG-Terms.
132     */
133    {
134      t.Ft1 : \{ (EVAR); (VVAR); (REF e); } \! $fail;
135      t.Ft2 : \{ (EVAR); (VVAR); (REF e); } \! $fail;
136      <MSG-Exprs (e.Fe1) e.Fe2> <MSG-Terms t.Ft1 t.Ft2>;
137    };
138  ((REF t.name) e.Fe1) e.Fe2, {
139    e.Fe2 : (REF t.name) e.Rest = (REF t.name) <MSG-Exprs (e.Fe1) e.Rest>;
140    <MSG-Exprs (<Format-Exp <Lookup &Const t.name>> e.Fe1) e.Fe2>;
141  };
142  (e.Fe1 (REF t.name)) e.Fe2, {
143    e.Fe2 : e.Rest (REF t.name) = <MSG-Exprs (e.Fe1) e.Rest> (REF t.name);
144    <MSG-Exprs (e.Fe1 <Format-Exp <Lookup &Const t.name>>) e.Fe2>;
145  };
146  (e.Fe1) (REF t.name) e.Fe2 =
147    <MSG-Exprs (e.Fe1) <Format-Exp <Lookup &Const t.name>> e.Fe2>;
148  (e.Fe1) e.Fe2 (REF t.name) =
149    <MSG-Exprs (e.Fe1) e.Fe2 <Format-Exp <Lookup &Const t.name>>>;
150  (e.Fe1) e.Fe2, {
151    <Empty-Expr? e.Fe1>, <Empty-Expr? e.Fe2> = /*empty*/;
152    /*
153     * If both e.Fe1 and e.Fe2 have non-(EVAR) terms then we can unify
154     * them to (VVAR). Be VERY careful! We can meet &C, but it easy can be
155     * that it points to empty expression.
156     */
157    \?
158    e.Fe1 : e t.Ft1 e, t.Ft1 : \{
159      (VVAR);
160      (REF t.name), # <Empty-Const? t.name>;
161    } \!
162      e.Fe2 : e t.Ft2 e, t.Ft2 : \{
163        (VVAR);
164        (REF t.name), # <Empty-Const? t.name>;
165      } =
166      (VVAR);
167    /*
168     * Else at least one of expressions has form of (EVAR)...(EVAR). So we
169     * should return (EVAR).
170     */
171    (EVAR);
172  };
173};
174
175MSG-Terms {
176  t.Ft t.Ft = t.Ft;
177  (PAREN e.Fe1) (PAREN e.Fe2) = (PAREN <MSG-Exprs (e.Fe1) e.Fe2>);
178  s s = (SVAR);
179  (SVAR) s = (SVAR);
180  s (SVAR) = (SVAR);
181  (SVAR) (SVAR) = (SVAR);
182  t t = (TVAR);
183};
184
185/*
186 * Ends good if e.Format2 is a special case of e.Format1 or coincide it.
187 */
188Subformat? (e.Format1) (e.Format2),/* <WriteLN TTT (e.Format1) (e.Format2)>,*/
189  e.Format1 : {
190    e.Format2 = ;
191    /*empty*/ = <Empty-Expr? e.Format2>;
192    (EVAR) = ;
193    /*
194     * If e.Format1 is (VVAR) then e.Format2 shouldn't be (EVAR) (EVAR) ...
195     * (EVAR). Be VERY careful! We can meet &C, but it easy can be that it
196     * points to empty expression.
197     */
198    (VVAR) =
199      e.Format2 : e t.HardTerm e,
200      # t.HardTerm : \{
201        (EVAR);
202        (REF t.Name), <Empty-Const? t.Name>;
203      };
204    (TVAR) =
205      e.Format2 : e0 t1 e2,
206      \{
207        <R 0 e0> :: t0, # <Empty-Expr? t0> = $fail;
208        t1 : \{
209          (REF t.Name), <Get-Const-Term t.Name> : e;
210          s.ObjectSymbol;
211          (SVAR);
212          (PAREN e);
213          (TVAR);
214        } =
215          <Empty-Expr? e2>;
216      };
217    (SVAR) =
218      e.Format2 : e0 t1 e2,
219      \{
220        <R 0 e0> :: t0, # <Empty-Expr? t0> = $fail;
221        t1 : \{
222          (REF t.Name), <Get-Const-Term t.Name> : term =
223            term : \{
224              s.ObjectSymbol;
225              (REF e);        // Reference to an object
226            },
227            <Empty-Expr? e2>;
228          s.ObjectSymbol = <Empty-Expr? e2>;
229          (SVAR) = <Empty-Expr? e2>;
230        };
231      };
232    (PAREN e.Format11) =
233      e.Format2 : e0 t1 e2,
234      \{
235        <R 0 e0> :: t0, # <Empty-Expr? t0> = $fail;
236        t1 : \{
237          (REF t.Name), <Get-Const-Term t.Name> : term =
238            term : (PAREN e.Format22),
239            <Empty-Expr? e2>,
240            <Subformat? (e.Format11) (e.Format22)>;
241          (PAREN e.Format22) =
242            <Empty-Expr? e2>,
243            <Subformat? (e.Format11) (e.Format22)>;
244        };
245      };
246    s.ObjectSymbol =
247      e.Format2 : e0 t1 e2,
248      \{
249        <R 0 e0> :: t0, # <Empty-Expr? t0> = $fail;
250        t1 : \{
251          (REF t.Name), <Get-Const-Term t.Name> : term =
252            <Empty-Expr? e2>,
253            term : s.ObjectSymbol;
254          symbol =
255            <Empty-Expr? e2>,
256            symbol : s.ObjectSymbol;
257        };
258      };
259    (REF t.Name) =
260      <Subformat? (<Format-Exp <Middle 3 0 <Lookup &Const t.Name>>>) (e.Format2)>;
261    v.first1 v.rest1, e.Format2 : e.first2 e.rest2,
262      <Subformat? (v.first1) (e.first2)> <Subformat? (v.rest1) (e.rest2)>;
263    e, e.Format2 (/*e.format*/) 0 $iter {
264      e.Format2 : e1 (REF t.Name) e2 =
265        e2 (e.format e1 <Format-Exp <Middle 3 0 <Lookup &Const t.Name>>>) 1;
266      (e.format e.Format2) s.success?;
267    } :: e.Format2 (e.format) s.success?,
268      e.Format2 : /*empty*/ =
269      \{
270        s.success? : 0 = $fail;
271        <Subformat? (e.Format1) (e.format)>;
272      };
273  };
274
275/*
276 * Is t.name a $const'ant with an empty value?
277 */
278Empty-Const? t.name = <Empty-Expr? <Middle 3 0 <Lookup &Const t.name>>>;
279
280/*
281 * Verifies that argument becomes empty expression after unfolding all
282 * $const'ants.
283 */
284Empty-Expr? {
285  e t1 e \?
286    {
287      t1 : (REF t2), <Empty-Const? t2> \! $fail;
288      = $fail;
289    };
290  empty;
291};
292
293/*
294 * If in the end the value of $const'ant t.name is term then return that term.
295 * Else $fail.
296 */
297Get-Const-Term t.name = <Get-Term <Middle 3 0 <Lookup &Const t.name>>>;
298
299/*
300 * If expression becomes term after unfolding all $const'ants then return that
301 * term. Else $fail.
302 */
303Get-Term e0 t1 e2,
304  # <Empty-Expr? t1> =
305  <Empty-Expr? e2>,
306  {
307    t1 : (REF t.Name), <Lookup &Const t.Name> :: e.const =
308      <Get-Term <Middle 3 0 e.const>>;
309    t1;
310  };
311
312
Note: See TracBrowser for help on using the repository browser.