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

Last change on this file since 3539 was 3539, checked in by yura, 13 years ago
  • Files are moved in src dir.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.2 KB
Line 
1// $Source$
2// $Revision: 3539 $
3// $Date: 2008-03-15 20:05:22 +0000 (Sat, 15 Mar 2008) $
4
5
6//***********************************  ************************************
7//*********** Упорядоченное хранилище клешей и операции с ним *************
8
9$use Access Apply Arithm Box Compare List StdIO Table;
10
11$use "rfp_asail";
12$use "rfp_const";
13$use "rfp_vars";
14$use "rfp_helper";
15
16
17/*
18 * Собственно, хранилище.
19 */
20$box Clashes;
21/*
22 * Хранятся в нём клеши в следующем формате:
23 *
24 * t.clash ::= (s.idx (e.Re) (s.dir e.Pe) e.boxes)
25 *
26 * e.boxes -- список ящиков, обозначающих свойства данного клеша.  В этих
27 * ящиках находятся номера клешей, обладающих заданным свойством и, возможно,
28 * некая дополнительная информация для каждого клеша.
29 *
30 *
31 * Ящики бывают следующие.
32 *
33 */
34
35
36/*
37 * Образец может иметь жёсткие по длине части слева и справа.  Сопоставление с
38 * этими частями выливается в проверку условий возможности такого сопоставления
39 * и заведение новых переменных.  Всё это делается до компиляции циклической
40 * части образца.
41 *
42 * В результате означивания новых переменных, жёсткие части образца могут
43 * удлинняться.  Следующая таблица по индексу клеша хранит запись вида:
44 * (e.left) (e.right) expr.
45 * e.left  -- выражение, в ран-тайм получающее значение длины жёсткой части
46 * слева.
47 * e.right -- аналогичное выражение для длины жёсткой части справа.
48 * expr    -- часть выражения между жёсткими кусками.
49 */
50$table Hard_Parts;
51
52
53$box Parenth;
54
55
56$box Unready_Source;
57
58
59
60$func Entries e.expr (e.source) = s.num e.res;
61/*
62 * Returns number of e.expr entries in e.source and e.source without all e.expr's.
63 */
64Entries e.expr (e.source) =
65  0 e.source () $iter {
66    e.source : e1 e.expr e2 = <Add s.num 1> e2 (e.res e1);
67    s.num (e.res e.source);
68  } :: s.num e.source (e.res),
69  e.source : /*empty*/ =
70  s.num e.res;
71
72
73
74$func Add_Clash_To_Var e = e;
75
76Add_Clash_To_Var t.clash t.var =
77  <Set_Var (Clashes <Get_Var Clashes t.var> t.clash) t.var>;
78
79$func Classify_Lengths t.clash = e.boxes;
80
81$func Compute_Bounds s.idx (e.len_Re) (e.vars_Re) (e.len_Pe) (e.vars_Pe) = ;
82$func Compute_Max s.idx (e.len1) (e.vars1) (e.len2) (e.vars2) t.var1 = ;
83$func Compute_Min s.idx (e.len1) (e.vars1) (e.len2) (e.vars2) t.var1 = ;
84
85Classify_Lengths (s.idx (e.Re) (s.dir e.Pe) e) =
86  <Get_Known_Length e.Re> :: e.len_Re (e.vars_Re),
87  <Get_Known_Length e.Pe> :: e.len_Pe (e.vars_Pe),
88  {
89    /*
90     * Если длины всех переменных на верхних уровнях e.Re и e.Pe
91     * известны, кладём клеш в ящик &Known-Lengths.
92     */
93    e.vars_Re : /*empty*/, e.vars_Pe : /*empty*/ =
94      <Bind &Known_Lengths (s.idx) ((e.len_Re) (e.len_Pe))>,
95      &Known_Lengths;
96    /*
97     * Если на верхнем уровне во всём клеше ровно одна переменная с
98     * неизвестной длинной, и она входит в левую и правую части разное
99     * кол-во раз, то её длину можно вычислить.
100     * В каждой переменной делаем пометку, что она используется в этом клеше.
101     * Кладём клеш в ящик &Compute-Length.
102     */
103    <Arithm.Sub <Length e.vars_Re> <Length e.vars_Pe>> :: s.diff,
104      <Ne (s.diff) (0)>,
105      <Nub e.vars_Re e.vars_Pe> : t.var =
106      {
107        <Lt (s.diff) (0)> = <Mult s.diff -1> (e.len_Re) (e.len_Pe);
108        s.diff (e.len_Pe) (e.len_Re);
109      } :: s.mult (e.minuend) (e.subtrahend),
110      <Map &Add_Clash_To_Var s.idx (e.vars_Re e.vars_Pe)> : e,
111      <Bind &Compute_Length (s.idx) (t.var s.mult (e.minuend) (e.subtrahend))>,
112      &Compute_Length;
113    /*
114     * В оставшихся случаях, всё, что мы можем сделать -- выписать
115     * граничные условия и ждать, пока не появится новой информации о длине
116     * каких-либо переменных.
117     * В каждой переменной делаем пометку, что она используется в этом клеше.
118     * Кладём клеш в таблицу &Unknown-Lengths.
119     */
120    <Compute_Bounds s.idx (e.len_Re) (e.vars_Re) (e.len_Pe) (e.vars_Pe)>,
121      <Map &Add_Clash_To_Var s.idx (e.vars_Re e.vars_Pe)> : e,
122      <Bind &Unknown_Lengths
123        (s.idx) ((e.len_Re) (e.len_Pe) (e.vars_Re) (e.vars_Pe))>,
124      &Unknown_Lengths;
125  };
126
127Compute_Bounds s.idx (e.len_Re) (e.vars_Re) (e.len_Pe) (e.vars_Pe) =
128  (e.vars_Re) (e.vars_Pe) $iter {
129    e.vars_Re : e1 t.var e2, \{ e.vars_Pe : e3 t.var e4 = (e1 e2) (e3 e4); };
130    (e.vars_Re) (e.vars_Pe) Stop;
131  } :: (e.vars_Re) (e.vars_Pe) e.stop,
132  e.stop : Stop =
133  <Map &Compute_Max s.idx (e.len_Pe) (e.vars_Pe) (e.len_Re) (e.vars_Re) (e.vars_Pe)> : e,
134  <Map &Compute_Min s.idx (e.len_Re) (e.vars_Re) (e.len_Pe) (e.vars_Pe) (e.vars_Re)> : e;
135
136Compute_Max s.idx (e.len1) (e.vars1) (e.len2) (e.vars2) t.var1 =
137  <"rfp_clashes.Entries" t.var1 (e.vars1)> :: s.n e.vars_left,
138  <Set_Var_MaxBound t.var1 s.idx
139    <ASAIL_DIV
140      <ASAIL_SUB        <ASAIL_ADD e.len2 <Map &Get_Var_Max (e.vars2)>>
141            <ASAIL_ADD e.len1 <Map &Get_Var_Min (e.vars_left)>>>
142      s.n>>;
143
144Compute_Min s.idx (e.len1) (e.vars1) (e.len2) (e.vars2) t.var1 =
145  <"rfp_clashes.Entries" t.var1 (e.vars1)> :: s.n e.vars_left,
146  <Set_Var_MinBound t.var1 s.idx
147    <ASAIL_DIV
148      <ASAIL_SUB        <ASAIL_ADD e.len2 <Map &Get_Var_Min (e.vars2)>>
149            <ASAIL_ADD e.len1 <Map &Get_Var_Max (e.vars_left)>>>
150      s.n>>;
151
152
153Reclassify_Clash s.idx, {
154  <Get &Clashes> : e1 (s.idx (e.Re) (s.dir e.Pe) e.boxes) e2,
155    <List.Sub (e.boxes) &Compute_Length &Unknown_Lengths> :: e.boxes1,
156    <Unbind &Compute_Length s.idx>,
157    <Unbind &Unknown_Lengths s.idx>,
158    <Classify_Lengths (s.idx (e.Re) (s.dir e.Pe))> :: e.boxes2,
159    <Store &Clashes e1 (s.idx (e.Re) (s.dir e.Pe) e.boxes1 e.boxes2) e2>;
160  /*
161   * Может оказаться, что клеша с номером s.idx уже нет в хранилище -- из памяти
162   * переменных клеши не удаляются.  В этом случае просто не надо ничего делать.
163   */
164  ;
165};
166
167
168
169//********************* Индекс для нумерации клешей ***********************
170
171$box FreeIdx;
172
173$func Free_Index = s.idx;
174
175Free_Index =
176  <Get &FreeIdx> : s.idx,
177  <Store &FreeIdx <Arithm.Add s.idx 1>>,
178  s.idx;
179
180
181
182//**************************** Инициализация ******************************
183
184$func Compose_Clashes e.clashes = e.clashes;
185
186Init_Clashes e.clashes =
187  <ClearTable &Known_Lengths>,
188  <ClearTable &Compute_Length>,
189  <ClearTable &Unknown_Lengths>,
190  <Store &Checked_Lengths /*empty*/>,
191  <Store &Eqs /*empty*/>,
192  <Store &Parenth /*empty*/>,
193  <Store &Unready_Source /*empty*/>,
194  <ClearTable &Hard_Parts>,
195  <Store &FreeIdx 0>,
196  <Store &Clashes <Compose_Clashes e.clashes>>;
197
198Compose_Clashes {
199  (e.Re) (s.dir e.Pe) e.rest =
200    <Free_Index> :: s.idx,
201    <Classify_Lengths (s.idx (e.Re) (s.dir e.Pe))> :: e.boxes,
202    {
203      \{
204        <Get_Var "Instantiated?" e.Re> : True;
205        e.Re : (REF e);
206        e.Re : (STATIC e);
207      };
208      e.Pe : e1 (PAREN e) e2 =
209        <Vars e.Re> :: e.Re_vars,
210        <Put &Parenth (s.idx (e.Re_vars) <Vars e1>)>,
211        {
212          e2 : $r e (PAREN e) e3 =
213            <Put &Parenth (s.idx (e.Re_vars) <Vars e3>)>;;
214        },
215        <Put &Unready_Source (s.idx e.Re_vars)>;
216      <Put &Unready_Source (s.idx <Vars e.Re>)>;
217    },
218    (s.idx (e.Re) (s.dir e.Pe) e.boxes) <Compose_Clashes e.rest>;;
219};
220
221
222
223
224//****** Обновление информации о жёстких началах и концах образцов ********
225
226$func UHP (e.conds) (e.assigns) e.clashes = e.clashes (e.actions);
227
228$func UHP_Clash s.dir s.fun s.l s.r (e.conds) (e.assigns) (e.pos) (e.Re) e.Pe =
229  e.clashes (e.conds) (e.assigns) (e.pos) (e.Pe);
230
231/*
232 * Просматриваем все имеющиеся клеши.
233 * Если в результате новой информации о переменных, входящих в образец, можно
234 * утверждать что жёсткие части удлиннились, запоминаем эту информацию в
235 * таблице &Hard-Parts, заводим новые клеши, получающиеся из скобок в образце,
236 * и возвращаем условия и присваивания, нужные, чтобы завести эти клеши.
237 * Новые, входящие в жёсткие, части образца, не являющиеся скобками, кладутся в
238 * ящик &Eqs вместе с результатным выражением и с позицией в этом выражении с
239 * которой надо эти части сопоставлять.
240 */
241Update_Hard_Parts =
242  <UHP () () <Get &Clashes>> :: e.clashes (e.actions),
243  <Store &Clashes e.clashes>,
244  e.actions;
245
246UHP (e.conds) (e.assigns) e.clashes, e.clashes : {
247  t.clash e.rest,
248    t.clash : (s.idx (t.Re) (s.dir e.Pe) e),
249    \{
250      <Get_Var "Instantiated?" t.Re> : True;
251      t.Re : (REF e);
252      t.Re : (STATIC e);
253    } =
254    {
255      <Lookup &Hard_Parts s.idx>;
256      (0) (0) e.Pe;
257    } : (e.left) (e.right) expr,
258    <UHP_Clash s.dir &L 1 0 () () (e.left ) (t.Re) expr>
259      :: e.l_clashes (e.l_conds) (e.l_assigns) (e.left ) (expr),
260    <UHP_Clash s.dir &R 0 1 () () (e.right) (t.Re) expr>
261      :: e.r_clashes (e.r_conds) (e.r_assigns) (e.right) (expr),
262    <Bind &Hard_Parts (s.idx) ((e.left) (e.right) expr)>,
263    <Compose_Clashes e.l_clashes> t.clash <Compose_Clashes e.r_clashes>
264    <UHP (e.conds e.l_conds e.r_conds) (e.assigns e.l_assigns e.r_assigns) e.rest>;
265  t.unready_clash e.rest = t.unready_clash <UHP (e.conds) (e.assigns) e.rest>;
266  /*empty*/ = (e.conds e.assigns);
267};
268
269/*
270 * Функция, занимающаяся непосредственно проверкой составляющих образца на
271 * вычислимость длин, начиная слева или справа, в зависимости от s.dir.
272 *
273 * Если очередной терм -- это скобки, то должен быть заведён новый клеш,
274 * образованный из содержимого скобок.  Перед этим надо произвести проверку на
275 * то, что в результатном выражении в этом месте тоже стоят скобки, и завести
276 * переменную, обозначающую их содержимое.
277 * Данная функция возвращает всю информацию, необходимую для этих действий.
278 */
279UHP_Clash s.dir s.fun s.l s.r (e.conds) (e.assigns) (e.pos) (e.Re) e.Pe, {
280  e.Pe : v, <Apply s.fun 0 e.Pe> : t.Pt, {
281    <Get_Known_Length t.Pt> : e.len (), {
282      t.Pt : (PAREN expr) =
283        <Gener_Vars ((VAR)) "deref_" e.Re> : t.var,
284        <Set_Var ("Instantiated?" True) t.var>,
285        {
286          s.fun : &R = RIGHT e.pos 1;
287          LEFT e.pos;
288        } :: e.pos,
289        (("SYMBOL?" e.Re (e.pos)))
290        ((DEREF t.var e.Re (e.pos)))
291        (t.var) (s.dir expr);
292      {
293        s.fun : &R = <Put &Eqs ((e.Re) (RIGHT e.pos e.len) t.Pt (e.len))>;
294        <Put &Eqs ((e.Re) (LEFT e.pos) t.Pt (e.len))>;
295      },
296        () () /*empty*/;
297    } :: (e.cond) (e.assign) e.clash =
298      e.clash
299      <UHP_Clash s.dir s.fun s.l s.r (e.conds e.cond) (e.assigns e.assign)
300        (e.pos e.len) (e.Re) <Middle s.l s.r e.Pe>>;
301    (e.conds) (e.assigns) (e.pos) (e.Pe);
302  };
303  (e.conds) (e.assigns) (e.pos) ();
304};
305
306
307
308
309$func Prepare_Source e.source = t.var e.assign;
310
311$func Define_Vars e.vars = e.eqs;
312
313Prepare_Source {
314  t.Re, \{
315    <Get_Var "Instantiated?" t.Re> : True;
316    t.Re : (REF e);
317    t.Re : (STATIC e);
318  } =
319    t.Re /*empty*/;
320  t.Re, <IsVar t.Re> =
321    t.Re <Define_Vars t.Re>;
322  e.Re =
323    <Gener_Vars ((EVAR)) "compose"> : t.var,
324    <Set_Var ("Instantiated?" True) t.var>,
325    <Vars_Decl Expr t.var> : e, // ???
326    t.var <Define_Vars <Vars e.Re>> (DECL Expr <Vars_Print t.var> e.Re);
327};
328
329Define_Vars {
330  t.var e.rest =
331    {
332      <Get_Var "Instantiated?" t.var> : True = <Define_Vars e.rest>;
333      <Get &Eqs> : e1 (t.Re t.pos t.var t.len) e2 =
334        <Store &Eqs e1 e2>,
335        (t.Re t.pos t.var t.len) <Define_Vars e.rest>;
336    };
337  /*empty*/ = /*empty*/;
338};
339
340
341
342$func Find_SFD e.parenth = e.parenth (e.idx);
343
344$func? Not_Instantiated_Var e = e;
345
346$func? Not_Idx e = e;
347
348Not_Idx {
349  s.idx (s.idx e) = $fail;
350  e.else_true;
351};
352
353Compose_Source = \{
354  <Find_SFD <Get &Parenth>> : e.parenth (s.idx) =
355    <Store &Parenth e.parenth>,
356    <Store &Unready_Source <Filter &Not_Idx s.idx (<Get &Unready_Source>)>>,
357    s.idx;
358  <Get &Unready_Source> : e.l (s.idx e.vars) e.r,
359    <Filter &Not_Instantiated_Var (e.vars)> : /*empty*/ =
360    <Store &Unready_Source e.l e.r>,
361    <Store &Parenth <Filter &Not_Idx s.idx (<Get &Parenth>)>>,
362    s.idx;
363} :: s.idx,
364  {
365    <Get &Clashes> : e1 (s.idx (e.Re) (s.dir e.Pe) e.boxes) e2,
366      <Prepare_Source e.Re> :: t.var e.assign,
367      <Store &Clashes e1 (s.idx (t.var) (s.dir e.Pe) e.boxes) e2>,
368      e.assign;
369  };
370
371Find_SFD {
372  (s.idx (e.Re_vars) e.Pe_vars) e.rest =
373    <Filter &Not_Instantiated_Var (e.Re_vars)> : {
374      v.r_vars = (s.idx (v.r_vars) e.Pe_vars) <Find_SFD e.rest>;
375      /*empty*/ = <Get_Known_Length e.Pe_vars> : {
376        e (v.p_vars) = (s.idx () v.p_vars) <Find_SFD e.rest>;
377        e () = <Filter &Not_Idx s.idx (e.rest)> (s.idx);
378      };
379    };
380  /*empty*/ = ();
381};
382
383Not_Instantiated_Var t.var = # \{
384  <Get_Var "Instantiated?" t.var> : True;
385  <Get &Eqs> : e (t t t.var t) e;
386};
387
388
389
390Get_Cycle =
391  <Get &Clashes> : e (s.idx (t.var) (s.dir e.Pe) e.b1 &Unknown_Lengths e.b2) e.rest =
392  <Get_Known_Length t.var> : e.len (),
393  <Lookup &Hard_Parts s.idx> : (e.left) (e.right) e.expr,
394  s.dir : {
395    LEFT =
396      e.expr : t.var_e1 e.Pe_rest,
397      LSPLIT t.var_e1 "lsplit_" e.Pe_rest;
398    RIGHT =
399      e.expr : e.Pe_rest t.var_e1,
400      RSPLIT t.var_e1 "rsplit_" e.Pe_rest;
401  } :: s.split t.var_e1 s.pref_e2 e.Pe_rest,
402  {
403    <IsVar e.Pe_rest> =
404      e.Pe_rest ((e.Pe_rest) (s.dir <Gener_Len_Var e.Pe_rest>));
405//      <Vars-Reset e.Pe-rest>;
406    <Gener_Vars ((VAR)) s.pref_e2 t.var> : t.var_e2,
407      t.var_e2 ((t.var_e2) (s.dir e.Pe_rest));
408  } : t.var_e2 (e.clash),
409  <Set_Var ("Instantiated?" True) t.var_e1>,
410  <Set_Var ("Instantiated?" True) t.var_e2>,
411  <Store &Clashes <Compose_Clashes e.clash> e.rest>,
412  <Get_Var Clashes t.var_e1> <Get_Var Clashes t.var_e2> :: e.clashes,
413  <Map &Reclassify_Clash (<List.Sub (e.clashes) <Get &Checked_Lengths>>)> : e,
414  s.split (e.left) (e.right) (e.len) t.var t.var_e1 t.var_e2;
415
416
417
418
419$func Ref_Len t.name = e.length;
420
421/*
422 * Из верхнего уровня выражения изымаются все переменные, длина которых не
423 * может быть посчитана (она неизвестна из формата, и переменная ещё не
424 * получила значение в run-time).  Список этих переменных возвращается вторым
425 * параметром.  Первым параметром возвращается длина оставшегося после их
426 * изъятия выражения.
427 */
428Get_Known_Length e.Re =
429  e.Re (/*e.length*/) (/*e.unknown-vars*/) $iter {
430    e.Re : t.Rt e.rest, t.Rt : {
431      s.ObjectSymbol = 1 ();    // Может появиться из константы.
432      (PAREN e) = 1 ();
433      (FUNC e) = 1 ();
434      ("FUNC?" e) = 1 ();
435      (REF t.name) = <Ref_Len t.name> ();
436      (STATIC t.name) = <Get_Known_Length <Get_Static t.Rt>>;
437      t, <IsVar t.Rt>, {
438        <Get_Var Length t.Rt> : v.len = v.len ();
439        /*empty*/ (t.Rt);
440      };
441    } :: e.len (e.var),
442      e.rest (e.length e.len) (e.unknown_vars e.var);
443  } :: e.Re (e.length) (e.unknown_vars),
444  e.Re : /*empty*/ =
445  {
446    e.length : /*empty*/ = 0 (e.unknown_vars);
447    e.length (e.unknown_vars);
448  };
449
450$table Const_Len;  // Fixme: инициализировать когда?
451
452Ref_Len t.name = {
453  <Lookup &Const_Len t.name>;
454  <Get_Known_Length <Middle 2 0 <Lookup &Const t.name>>> :: e.len t =
455    <Bind &Const_Len (t.name) (e.len)>,
456    e.len;
457  1;
458};
459
460
Note: See TracBrowser for help on using the repository browser.