source: to-imperative/trunk/compiler/rfp_clashes.rf @ 1146

Last change on this file since 1146 was 1146, checked in by orlov, 17 years ago
  • Support for references to functions. Including ones with formats other then

e = e.

  • Support for iterative splitting from the right.
  • Composition of clashes left hand side is corrected.
  • Renaming of variables is corrected.
  • Some other small bugs are fixed.
  • A lot of unused code is throwed away, some code is cleaned up, some comments

are added.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.1 KB
Line 
1// $Source$
2// $Revision: 1146 $
3// $Date: 2003-08-10 22:36:28 +0000 (Sun, 10 Aug 2003) $
4
5
6************************************  ************************************
7************ Упорядоченное хранилище клешей и операции с ним *************
8
9$use Access Apply Arithm Box Compare StdIO Table;
10
11$use "rfp_const";
12$use "rfp_vars";
13$use "rfp_list";
14$use "rfp_helper";
15$use "rfp_compile";
16
17
18/*
19 * Собственно, хранилище.
20 */
21$box Clashes;
22/*
23 * Хранятся в нём клеши в следующем формате:
24 *
25 * t.clash ::= (s.idx (e.Re) (s.dir e.Pe) e.boxes)
26 *
27 * e.boxes -- список ящиков, обозначающих свойства данного клеша.  В этих
28 * ящиках находятся номера клешей, обладающих заданным свойством и, возможно,
29 * некая дополнительная информация для каждого клеша.
30 *
31 *
32 * Ящики бывают следующие.
33 *
34 */
35
36
37/*
38 * Образец может иметь жёсткие по длине части слева и справа.  Сопоставление с
39 * этими частями выливается в проверку условий возможности такого сопоставления
40 * и заведение новых переменных.  Всё это делается до компиляции циклической
41 * части образца.
42 *
43 * В результате означивания новых переменных, жёсткие части образца могут
44 * удлинняться.  Следующая таблица по индексу клеша хранит запись вида:
45 * (e.left) (e.right) expr.
46 * e.left  -- выражение, в ран-тайм получающее значение длины жёсткой части
47 * слева.
48 * e.right -- аналогичное выражение для длины жёсткой части справа.
49 * expr    -- часть выражения между жёсткими кусками.
50 */
51$table Hard-Parts;
52
53
54$box Parenth;
55
56
57$box Unready-Source;
58
59
60
61
62
63$func Add-Clash-To-Var e = e;
64
65Add-Clash-To-Var t.clash t.var =
66  <Set-Var (Clashes <Get-Var Clashes t.var> t.clash) t.var>;
67
68$func Classify-Lengths t.clash = e.boxes;
69
70Classify-Lengths (s.idx (e.Re) (s.dir e.Pe) e) =
71  <Get-Known-Length e.Re> :: e.len-Re (e.vars-Re),
72  <Get-Known-Length e.Pe> :: e.len-Pe (e.vars-Pe),
73  {
74    /*
75     * Если длины всех переменных на верхних уровнях e.Re и e.Pe
76     * известны, кладём клеш в ящик &Known-Lengths.
77     */
78    e.vars-Re : /*empty*/, e.vars-Pe : /*empty*/ =
79      <Bind &Known-Lengths (s.idx) ((e.len-Re) (e.len-Pe))>,
80      &Known-Lengths;
81    /*
82     * Если на верхнем уровне во всём клеше ровно одна переменная с
83     * неизвестной длинной, и она входит в левую и правую части разное
84     * кол-во раз, то её длину можно вычислить.
85     * В каждой переменной делаем пометку, что она используется в этом клеше.
86     * Кладём клеш в ящик &Compute-Length.
87     */
88    <"-" <Length e.vars-Re> <Length e.vars-Pe>> :: s.diff,
89      <"/=" (s.diff) (0)>,
90      <Nub e.vars-Re e.vars-Pe> : t.var =
91      {
92        <"<" (s.diff) (0)> = <"*" s.diff -1> (e.len-Re) (e.len-Pe);
93        s.diff (e.len-Pe) (e.len-Re);
94      } :: s.mult (e.minuend) (e.subtrahend),
95      <Map &Add-Clash-To-Var s.idx (e.vars-Re e.vars-Pe)> : e,
96      <Bind &Compute-Length (s.idx) (t.var s.mult (e.minuend) (e.subtrahend))>,
97      &Compute-Length;
98    /*
99     * В оставшихся случаях, всё, что мы можем сделать -- выписать
100     * граничные условия и ждать, пока не появится новой информации о длине
101     * каких-либо переменных.
102     * В каждой переменной делаем пометку, что она используется в этом клеше.
103     * Кладём клеш в таблицу &Unknown-Lengths.
104     */
105    <Map &Add-Clash-To-Var s.idx (e.vars-Re e.vars-Pe)> : e,
106      <Bind &Unknown-Lengths
107        (s.idx) ((e.len-Re) (e.len-Pe) (e.vars-Re) (e.vars-Pe))>,
108      &Unknown-Lengths;
109  };
110
111
112/*
113 * Может оказаться, что клеша с номером s.idx уже нет в хранилище -- из памяти
114 * переменных клеши не удаляются.  В этом случае просто не надо ничего делать.
115 */
116Reclassify-Clash s.idx, {
117  <? &Clashes> : e1 (s.idx (e.Re) (s.dir e.Pe) e.boxes) e2,
118  <Sub (e.boxes) &Compute-Length &Unknown-Lengths> :: e.boxes1,
119  <Unbind &Compute-Length s.idx>,
120  <Unbind &Unknown-Lengths s.idx>,
121  <Classify-Lengths (s.idx (e.Re) (s.dir e.Pe))> :: e.boxes2,
122  <Store &Clashes e1 (s.idx (e.Re) (s.dir e.Pe) e.boxes1 e.boxes2) e2>;;
123};
124
125
126
127********************** Индекс для нумерации клешей ***********************
128
129$box FreeIdx;
130
131$func Free-Index = s.idx;
132
133Free-Index =
134  <? &FreeIdx> : s.idx,
135  <Store &FreeIdx <"+" s.idx 1>>,
136  s.idx;
137
138
139
140***************************** Инициализация ******************************
141
142$func Compose-Clashes e.clashes = e.clashes;
143
144Init-Clashes e.clashes =
145  <RFP-Clear-Table &Known-Lengths>,
146  <RFP-Clear-Table &Compute-Length>,
147  <RFP-Clear-Table &Unknown-Lengths>,
148  <Store &Checked-Lengths /*empty*/>,
149  <Store &Eqs /*empty*/>,
150  <Store &Parenth /*empty*/>,
151  <Store &Unready-Source /*empty*/>,
152  <RFP-Clear-Table &Hard-Parts>,
153  <Store &FreeIdx 0>,
154  <Store &Clashes <Compose-Clashes e.clashes>>;
155
156Compose-Clashes {
157  (e.Re) (s.dir e.Pe) e.rest =
158    <Free-Index> :: s.idx,
159    <Classify-Lengths (s.idx (e.Re) (s.dir e.Pe))> :: e.boxes,
160    {
161      \{
162        <Get-Var Instantiated? e.Re> : True;
163        e.Re : (REF e);
164        e.Re : (STATIC e);
165      };
166      e.Pe : e1 (PAREN e) e2 =
167        <Vars e.Re> :: e.Re-vars,
168        <Put &Parenth (s.idx (e.Re-vars) <Vars e1>)>,
169        {
170          e2 : $r e (PAREN e) e3 =
171            <Put &Parenth (s.idx (e.Re-vars) <Vars e3>)>;;
172        },
173        <Put &Unready-Source (s.idx e.Re-vars)>;
174      <Put &Unready-Source (s.idx <Vars e.Re>)>;
175    },
176    (s.idx (e.Re) (s.dir e.Pe) e.boxes) <Compose-Clashes e.rest>;;
177};
178
179
180
181
182******* Обновление информации о жёстких началах и концах образцов ********
183
184$func UHP (e.conds) (e.assigns) e.clashes = e.clashes (e.actions);
185
186$func UHP-Clash s.dir s.fun s.l s.r (e.conds) (e.assigns) (e.pos) (e.Re) e.Pe =
187  e.clashes (e.conds) (e.assigns) (e.pos) (e.Pe);
188
189/*
190 * Просматриваем все имеющиеся клеши.
191 * Если в результате новой информации о переменных, входящих в образец, можно
192 * утверждать что жёсткие части удлиннились, запоминаем эту информацию в
193 * таблице &Hard-Parts, заводим новые клеши, получающиеся из скобок в образце,
194 * и возвращаем условия и присваивания, нужные, чтобы завести эти клеши.
195 * Новые, входящие в жёсткие, части образца, не являющиеся скобками, кладутся в
196 * ящик &Eqs вместе с результатным выражением и с позицией в этом выражении с
197 * которой надо эти части сопоставлять.
198 */
199Update-Hard-Parts =
200  <UHP () () <? &Clashes>> :: e.clashes (e.actions),
201  <Store &Clashes e.clashes>,
202  e.actions;
203
204UHP (e.conds) (e.assigns) e.clashes, e.clashes : {
205  t.clash e.rest,
206    t.clash : (s.idx (t.Re) (s.dir e.Pe) e),
207    \{
208      <Get-Var Instantiated? t.Re> : True;
209      t.Re : (REF e);
210      t.Re : (STATIC e);
211    } =
212    {
213      <Lookup &Hard-Parts s.idx>;
214      (0) (0) e.Pe;
215    } : (e.left) (e.right) expr,
216    <UHP-Clash LEFT  &L- 1 0 () () (e.left ) (t.Re) expr>
217      :: e.l-clashes (e.l-conds) (e.l-assigns) (e.left ) (expr),
218    <UHP-Clash RIGHT &R- 0 1 () () (e.right) (t.Re) expr>
219      :: e.r-clashes (e.r-conds) (e.r-assigns) (e.right) (expr),
220    <Bind &Hard-Parts (s.idx) ((e.left) (e.right) expr)>,
221    <Compose-Clashes e.l-clashes> t.clash <Compose-Clashes e.r-clashes>
222    <UHP (e.conds e.l-conds e.r-conds) (e.assigns e.l-assigns e.r-assigns) e.rest>;
223  t.unready-clash e.rest = t.unready-clash <UHP (e.conds) (e.assigns) e.rest>;
224  /*empty*/ = (e.conds e.assigns);
225};
226
227/*
228 * Функция, занимающаяся непосредственно проверкой составляющих образца на
229 * вычислимость длин, начиная слева или справа, в зависимости от s.dir.
230 *
231 * Если очередной терм -- это скобки, то должен быть заведён новый клеш,
232 * образованный из содержимого скобок.  Перед этим надо произвести проверку на
233 * то, что в результатном выражении в этом месте тоже стоят скобки, и завести
234 * переменную, обозначающую их содержимое.
235 * Данная функция возвращает всю информацию, необходимую для этих действий.
236 */
237UHP-Clash s.dir s.fun s.l s.r (e.conds) (e.assigns) (e.pos) (e.Re) e.Pe, {
238  <Apply s.fun 0 e.Pe> : t.Pt, {
239    <Get-Known-Length t.Pt> : e.len (), {
240      t.Pt : (PAREN expr) =
241        <Gener-Vars ((VAR)) "deref_" e.Re> : t.var,
242        <Set-Var (Instantiated? True) t.var>,
243        ((SYMBOL? e.Re (s.dir e.pos)))
244        ((DEREF t.var e.Re (s.dir e.pos)))
245        (t.var) (s.dir expr);
246      <Put &Eqs ((e.Re) (s.dir e.pos) t.Pt (e.len))>,
247        () () /*empty*/;
248    } :: (e.cond) (e.assign) e.clash =
249      e.clash
250      <UHP-Clash s.dir s.fun s.l s.r (e.conds e.cond) (e.assigns e.assign)
251        (e.pos e.len) (e.Re) <Middle s.l s.r e.Pe>>;
252    (e.conds) (e.assigns) (e.pos) (e.Pe);
253  };
254  (e.conds) (e.assigns) (e.pos) ();
255};
256
257
258
259
260$func Prepare-Source e.source = t.var e.assign;
261
262$func Define-Vars e.vars = e.eqs;
263
264Prepare-Source {
265  t.Re, \{
266    <Get-Var Instantiated? t.Re> : True;
267    t.Re : (REF e);
268    t.Re : (STATIC e);
269  } =
270    t.Re /*empty*/;
271  t.Re, <Var? t.Re> =
272    t.Re <Define-Vars t.Re>;
273  e.Re =
274    <Gener-Vars ((EVAR)) "compose"> : t.var,
275    <Set-Var (Instantiated? True) t.var>,
276    <Vars-Decl t.var> : e, // ???
277    t.var <Define-Vars <Vars e.Re>> (EXPR <Vars-Print t.var> e.Re);
278};
279
280Define-Vars {
281  t.var e.rest =
282    {
283      <Get-Var Instantiated? t.var> : True = <Define-Vars e.rest>;
284      <? &Eqs> : e1 (t.Re t.pos t.var t.len) e2 =
285        <Store &Eqs e1 e2>,
286        (t.Re t.pos t.var t.len) <Define-Vars e.rest>;
287    };
288  /*empty*/ = /*empty*/;
289};
290
291
292
293$func Find-SFD e.parenth = e.parenth (e.idx);
294
295$func? Not-Instantiated-Var e = e;
296
297$func? Not-Idx e = e;
298
299Not-Idx {
300  s.idx (s.idx e) = $fail;
301  e.else-true;
302};
303
304Compose-Source = \{
305  <Find-SFD <? &Parenth>> : e.parenth (s.idx) =
306    <Store &Parenth e.parenth>,
307    <Store &Unready-Source <Filter &Not-Idx s.idx (<? &Unready-Source>)>>,
308    s.idx;
309  <? &Unready-Source> : e.l (s.idx e.vars) e.r,
310    <Filter &Not-Instantiated-Var (e.vars)> : /*empty*/ =
311    <Store &Unready-Source e.l e.r>,
312    <Store &Parenth <Filter &Not-Idx s.idx (<? &Parenth>)>>,
313    s.idx;
314} :: s.idx,
315  {
316    <? &Clashes> : e1 (s.idx (e.Re) (s.dir e.Pe) e.boxes) e2,
317      <Prepare-Source e.Re> :: t.var e.assign,
318      <Store &Clashes e1 (s.idx (t.var) (s.dir e.Pe) e.boxes) e2>,
319      e.assign;
320  };
321
322Find-SFD {
323  (s.idx (e.Re-vars) e.Pe-vars) e.rest =
324    <Filter &Not-Instantiated-Var (e.Re-vars)> : {
325      v.r-vars = (s.idx (v.r-vars) e.Pe-vars) <Find-SFD e.rest>;
326      /*empty*/ = <Get-Known-Length e.Pe-vars> : {
327        e (v.p-vars) = (s.idx () v.p-vars) <Find-SFD e.rest>;
328        e () = <Filter &Not-Idx s.idx (e.rest)> (s.idx);
329      };
330    };
331  /*empty*/ = ();
332};
333
334Not-Instantiated-Var t.var = # \{
335  <Get-Var Instantiated? t.var> : True;
336  <? &Eqs> : e (t t t.var t) e;
337};
338
339
340
341Get-Cycle =
342  <? &Clashes> : e (s.idx (t.var) (s.dir e.Pe) e.b1 &Unknown-Lengths e.b2) e.rest =
343  <Get-Known-Length t.var> : e.len (),
344  <Lookup &Hard-Parts s.idx> : (e.left) (e.right) e.expr,
345  s.dir : {
346    LEFT =
347      e.expr : t.var-e1 e.Pe-rest,
348      LSPLIT t.var-e1 "lsplit_" e.Pe-rest;
349    RIGHT =
350      e.expr : e.Pe-rest t.var-e1,
351      RSPLIT t.var-e1 "rsplit_" e.Pe-rest;
352  } :: s.split t.var-e1 s.pref-e2 e.Pe-rest,
353  {
354    <Var? e.Pe-rest> = e.Pe-rest ();
355    <Gener-Vars ((VAR)) s.pref-e2 t.var> : t.var-e2,
356      t.var-e2 ((t.var-e2) (s.dir e.Pe-rest));
357  } : t.var-e2 (e.clash),
358  <Set-Var (Instantiated? True) t.var-e1>,
359  <Set-Var (Instantiated? True) t.var-e2>,
360  <Store &Clashes <Compose-Clashes e.clash> e.rest>,
361  <Get-Var Clashes t.var-e1> :: e.clashes,
362  <Map &Reclassify-Clash (<Sub (e.clashes) <? &Checked-Lengths>>)> : e,
363  s.split (e.left) (e.right) (e.len) t.var t.var-e1 t.var-e2;
364
365
366
367
368$func Ref-Len t.name = e.length;
369
370/*
371 * Из верхнего уровня выражения изымаются все переменные, длина которых не
372 * может быть посчитана (она неизвестна из формата, и переменная ещё не
373 * получила значение в run-time).  Список этих переменных возвращается вторым
374 * параметром.  Первым параметром возвращается длина оставшегося после их
375 * изъятия выражения.
376 */
377Get-Known-Length e.Re =
378  e.Re (/*e.length*/) (/*e.unknown-vars*/) $iter {
379    e.Re : t.Rt e.rest, t.Rt : {
380      s.ObjectSymbol = 1 ();    // Может появиться из константы.
381      (PAREN e) = 1 ();
382      (REF t.name) = <Ref-Len t.name> ();
383      (STATIC t.name) = <Get-Known-Length <Get-Static t.Rt>>;
384      t, <Var? t.Rt>, {
385        <Get-Var Length t.Rt> : v.len = v.len ();
386        /*empty*/ (t.Rt);
387      };
388    } :: e.len (e.var),
389      e.rest (e.length e.len) (e.unknown-vars e.var);
390  } :: e.Re (e.length) (e.unknown-vars),
391  e.Re : /*empty*/ =
392  {
393    e.length : /*empty*/ = 0 (e.unknown-vars);
394    e.length (e.unknown-vars);
395  };
396
397$table Const-Len;  // Fixme: инициализировать когда?
398
399Ref-Len t.name = {
400  <Lookup &Const-Len t.name>;
401  <Get-Known-Length <Middle 3 0 <Lookup &Const t.name>>> :: e.len t =
402    <Bind &Const-Len (t.name) (e.len)>,
403    e.len;
404  1;
405};
406
407
Note: See TracBrowser for help on using the repository browser.