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

Last change on this file since 1006 was 1006, checked in by orlov, 18 years ago
  • Implemented composition of sources for clashes.
  • Some silly bugs are fixed.
  • Some comments.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.9 KB
Line 
1// $Source$
2// $Revision: 1006 $
3// $Date: 2003-07-12 07:37:29 +0000 (Sat, 12 Jul 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 Parenth1;
55$box Parenth2;
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  <RFP-Clear-Table &Known-Lengths>,
144  <RFP-Clear-Table &Compute-Length>,
145  <RFP-Clear-Table &Unknown-Lengths>,
146  <Store &Checked-Lengths /*empty*/>,
147  <Store &Eqs /*empty*/>,
148  <Store &Parenth1 /*empty*/>,
149  <Store &Parenth2 /*empty*/>,
150  <RFP-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      {
165        e.Re : t = &Parenth1;
166        &Parenth2;
167      } :: s.box,
168        {
169          e.Pe : e1 (PAREN e) e2 =
170            <Put s.box (s.idx (<Vars e.Re>) <Vars e1>)>,
171            {
172              e2 : $r e (PAREN e) e3 =
173                <Put s.box (s.idx (<Vars e.Re>) <Vars e3>)>;;
174            };;
175        };
176    },
177    (s.idx (e.Re) (s.dir e.Pe) e.boxes) <Compose-Clashes e.rest>;;
178};
179
180
181
182
183******* Обновление информации о жёстких началах и концах образцов ********
184
185$func UHP (e.conds) (e.assigns) e.clashes = e.clashes (e.actions);
186
187$func UHP-Clash s.dir s.fun s.l s.r (e.conds) (e.assigns) (e.pos) (e.Re) e.Pe =
188  e.clashes (e.conds) (e.assigns) (e.pos) (e.Pe);
189
190/*
191 * Просматриваем все имеющиеся клеши.
192 * Если в результате новой информации о переменных, входящих в образец, можно
193 * утверждать что жёсткие части удлиннились, запоминаем эту информацию в
194 * таблице &Hard-Parts, заводим новые клеши, получающиеся из скобок в образце,
195 * и возвращаем условия и присваивания, нужные, чтобы завести эти клеши.
196 * Новые, входящие в жёсткие, части образца, не являющиеся скобками, кладутся в
197 * ящик &Eqs вместе с результатным выражением и с позицией в этом выражении с
198 * которой надо эти части сопоставлять.
199 */
200Update-Hard-Parts =
201  <UHP () () <? &Clashes>> :: e.clashes (e.actions),
202  <Store &Clashes e.clashes>,
203  e.actions;
204
205UHP (e.conds) (e.assigns) e.clashes, e.clashes : {
206  t.clash e.rest,
207    t.clash : (s.idx (t.Re) (s.dir e.Pe) e),
208    \{
209      <Get-Var Instantiated? t.Re> : True;
210      t.Re : (REF e);
211      t.Re : (STATIC e);
212    } =
213    {
214      <Lookup &Hard-Parts s.idx>;
215      (0) (0) e.Pe;
216    } : (e.left) (e.right) expr,
217    <UHP-Clash LEFT  &L- 1 0 () () (e.left ) (t.Re) expr>
218      :: e.l-clashes (e.l-conds) (e.l-assigns) (e.left ) (expr),
219    <UHP-Clash RIGHT &R- 0 1 () () (e.right) (t.Re) expr>
220      :: e.r-clashes (e.r-conds) (e.r-assigns) (e.right) (expr),
221    <Bind &Hard-Parts (s.idx) ((e.left) (e.right) expr)>,
222    <Compose-Clashes e.l-clashes> t.clash <Compose-Clashes e.r-clashes>
223    <UHP (e.conds e.l-conds e.r-conds) (e.assigns e.l-assigns e.r-assigns) e.rest>;
224  t.unready-clash e.rest = t.unready-clash <UHP (e.conds) (e.assigns) e.rest>;
225  /*empty*/ = (e.conds e.assigns);
226};
227
228/*
229 * Функция, занимающаяся непосредственно проверкой составляющих образца на
230 * вычислимость длин, начиная слева или справа, в зависимости от s.dir.
231 *
232 * Если очередной терм -- это скобки, то должен быть заведён новый клеш,
233 * образованный из содержимого скобок.  Перед этим надо произвести проверку на
234 * то, что в результатном выражении в этом месте тоже стоят скобки, и завести
235 * переменную, обозначающую их содержимое.
236 *
237 * Данная функция возвращает всю информацию, необходимую для этих действий.
238 */
239UHP-Clash s.dir s.fun s.l s.r (e.conds) (e.assigns) (e.pos) (e.Re) e.Pe, {
240  <Apply s.fun 0 e.Pe> : t.Pt, {
241    <Get-Known-Length t.Pt> : e.len (), {
242      t.Pt : (PAREN expr) =
243        <Gener-Vars ((VAR)) "deref_" e.Re> : t.var,
244        <Set-Var (Instantiated? True) t.var>,
245        ((SYMBOL? e.Re (s.dir e.pos)))
246        ((DEREF t.var e.Re (s.dir e.pos)))
247        (t.var) (s.dir expr);
248      <Put &Eqs ((e.Re) (s.dir e.pos) t.Pt (e.len))>,
249        () () /*empty*/;
250    } :: (e.cond) (e.assign) e.clash =
251      e.clash
252      <UHP-Clash s.dir s.fun s.l s.r (e.conds e.cond) (e.assigns e.assign)
253        (e.pos e.len) (e.Re) <Middle s.l s.r e.Pe>>;
254    (e.conds) (e.assigns) (e.pos) (e.Pe);
255  };
256  (e.conds) (e.assigns) (e.pos) ();
257};
258
259
260
261
262$func Prepare-Source e.source = t.var e.assign;
263
264$func Define-Vars e.vars = e.eqs;
265
266Prepare-Source {
267  t.Re =
268    {
269      \{
270        <Get-Var Instantiated? t.Re> : True;
271        t.Re : (REF e);
272        t.Re : (STATIC e);
273      } =
274        t.Re /*empty*/;
275      t.Re <Define-Vars t.Re>;
276    };
277  e.Re =
278    <Gener-Vars ((EVAR)) "compose"> : t.var,
279    <Set-Var (Instantiated? True) t.var>,
280    <Vars-Decl t.var> : e, // ???
281    t.var <Define-Vars <Vars e.Re>> (EXPR <Vars-Print t.var> e.Re);
282};
283
284Define-Vars {
285  t.var e.rest =
286    {
287      <Get-Var Instantiated? t.var> : True;
288      <? &Eqs> : e1 (t.Re t.pos t.var t.len) e2 =
289        <Store &Eqs e1 e2>,
290        (t.Re t.pos t.var t.len) <Define-Vars e.rest>;
291      <Set-Var (Instantiated? True) t.var>; // STUB!!!
292    };
293  /*empty*/ = /*empty*/;
294};
295
296
297
298$func Find-SFD e.parenth = e.parenth (e.idx);
299
300Compose-Source-For-Deref =
301  <Find-SFD <? &Parenth1>> :: e.parenth1 (e.idx),
302  <Store &Parenth1 e.parenth1>,
303  {
304    e.idx : s.i = s.i;
305    <Find-SFD <? &Parenth2>> :: e.parenth2 (e.idx),
306      <Store &Parenth2 e.parenth2>,
307      e.idx : s.i = s.i;
308    /*else*/ = $fail;
309  } :: s.idx,
310  <? &Clashes> : e1 (s.idx (e.Re) (s.dir e.Pe) e) e2 =
311  <Prepare-Source e.Re> :: t.var e.assign,
312  <Store &Clashes e1 <Compose-Clashes (t.var) (s.dir e.Pe)> e2>,
313  e.assign;
314
315$func? Not-Instantiated-Var e = e;
316
317Find-SFD {
318  (s.idx (e.Re-vars) e.Pe-vars) e.rest =
319    <Filter &Not-Instantiated-Var (e.Re-vars)> : {
320      v.r-vars = (s.idx (v.r-vars) e.Pe-vars) <Find-SFD e.rest>;
321      /*empty*/ = <Get-Known-Length e.Pe-vars> : {
322        e (v.p-vars) = (s.idx () v.p-vars) <Find-SFD e.rest>;
323        e () = e.rest (s.idx);
324      };
325    };
326  /*empty*/ = ();
327};
328
329Not-Instantiated-Var t.var = # \{
330  <Get-Var Instantiated? t.var> : True;
331  <? &Eqs> : e (t t t.var t) e;
332};
333
334
335
336Get-Cycle =
337  <? &Clashes> : e (s.idx (e.Re) (s.dir e.Pe) e.b1 &Unknown-Lengths e.b2) e.rest =
338  <Prepare-Source e.Re> :: t.var e.assign,
339  <Get-Known-Length t.var> : e.len (),
340  <Lookup &Hard-Parts s.idx> : (e.left) (e.right) e.expr,
341  s.dir : {
342    LEFT =
343      e.expr : t.var-e1 e.Pe-rest,
344      t.var-e1 "lsplit_" e.Pe-rest;
345    RIGHT =
346      e.expr : e.Pe-rest t.var-e1,
347      t.var-e1 "rsplit_" e.Pe-rest;
348  } :: t.var-e1 s.pref-e2 e.Pe-rest,
349  {
350    <Var? e.Pe-rest> = e.Pe-rest ();
351    <Gener-Vars ((VAR)) s.pref-e2 t.var> : t.var-e2,
352      t.var-e2 ((t.var-e2) (s.dir e.Pe-rest));
353  } : t.var-e2 (e.clash),
354  <Set-Var (Instantiated? True) t.var-e1>,
355  <Set-Var (Instantiated? True) t.var-e2>,
356  <Store &Clashes <Compose-Clashes e.clash> e.rest>,
357  <Get-Var Clashes t.var-e1> :: e.clashes,
358  <Map &Reclassify-Clash (<Sub (e.clashes) <? &Checked-Lengths>>)> : e,
359  e.assign (e.left) (e.right) (e.len) t.var t.var-e1 t.var-e2;
360
361
362
363
364$func Ref-Len t.name = e.length;
365
366/*
367 * Из верхнего уровня выражения изымаются все переменные, длина которых не
368 * может быть посчитана (она неизвестна из формата, и переменная ещё не
369 * получила значение в run-time).  Список этих переменных возвращается вторым
370 * параметром.  Первым параметром возвращается длина оставшегося после их
371 * изъятия выражения.
372 */
373Get-Known-Length e.Re =
374  e.Re (/*e.length*/) (/*e.unknown-vars*/) $iter {
375    e.Re : t.Rt e.rest, t.Rt : {
376      s.ObjectSymbol = 1 ();    // Может появиться из константы.
377      (PAREN e) = 1 ();
378      (REF t.name) = <Ref-Len t.name> ();
379      (STATIC t.name) = <Get-Known-Length <Get-Static t.Rt>>;
380      t, <Var? t.Rt>, {
381        <Get-Var Length t.Rt> : v.len = v.len ();
382        /*empty*/ (t.Rt);
383      };
384    } :: e.len (e.var),
385      e.rest (e.length e.len) (e.unknown-vars e.var);
386  } :: e.Re (e.length) (e.unknown-vars),
387  e.Re : /*empty*/ =
388  {
389    e.length : /*empty*/ = 0 (e.unknown-vars);
390    e.length (e.unknown-vars);
391  };
392
393$table Const-Len;  // Fixme: инициализировать когда?
394
395Ref-Len t.name = {
396  <Lookup &Const-Len t.name>;
397  <Get-Known-Length <Middle 3 0 <Lookup &Const t.name>>> :: e.len t =
398    <Bind &Const-Len (t.name) (e.len)>,
399    e.len;
400  1;
401};
402
403
Note: See TracBrowser for help on using the repository browser.