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

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