source: to-imperative/trunk/compiler/rfp_compile.rf @ 1231

Last change on this file since 1231 was 1231, checked in by orlov, 17 years ago
  • Fixed $iter compilation.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 41.7 KB
Line 
1// $Source$
2// $Revision: 1231 $
3// $Date: 2003-08-15 13:30:23 +0000 (Fri, 15 Aug 2003) $
4
5$use "rfpc";
6$use "rfp_list";
7$use "rfp_helper";
8$use "rfp_check";
9$use "rfp_as2as";
10$use "rfp_format";
11$use "rfp_vars";
12$use "rfp_const";
13$use "rfp_clashes";
14
15$use StdIO;
16$use Table;
17$use Box;
18$use Arithm;
19$use Access;
20$use Compare;
21$use Convert;
22$use Class;
23$use Apply;
24$use Dos;
25
26
27/*
28 * Table for storing object names.
29 */
30$table Objects;
31
32/*
33 * Table for storing parameters of referenced functions.
34 */
35$table Stub-Funcs;
36
37/*
38 * Box for storing function out format
39 */
40$box Out-Format;
41
42/*
43 * Box for storing names for function result variables
44 */
45$box Res-Vars;
46
47/*
48 * Following table is used by Gener-Label function for obtaining unical (for
49 * certain function) label name.
50 * e.Key ::= e.QualifiedName      (parameter given to Gener-Label)
51 * e.Val ::= [Int]          (last index used with such e.QualifiedName)
52 */
53$table Labels;
54
55/*
56 * Table for storing variables used in place of preprocessor-generated ones.
57 */
58$table Prep-Vars;
59
60
61$func Compile (e.targets) (e.headers) e.Items = e.Compiled-Items (INTERFACE e.headers);
62
63$func Comp-Func-Stubs = e.asail-funcs;
64
65$func Comp-Func s.tag t.name e.params-and-body = e.compiled-func;
66
67$func Set-Drops (e.declared-exprs) e.comp-func = (e.declared-exprs) e.result-func;
68
69$func Comp-Sentence e.Sentence = e.asail-sentence;
70
71$func Save-Snt-State = ;
72
73$func Recall-Snt-State = ;
74
75$func Pop-Snt-State = ;
76
77$func Extract-Calls e.Re = (e.last-Re) e.calls;
78
79$func Get-Clash-Sequence (e.last-Re) e.Snt = (e.clashes) e.rest-of-the-Sentence;
80
81$func? Without-Calls? e.Re = ;
82
83$func Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence = e.asail-sentence;
84
85$func Gener-Label e.QualifiedName = t.label;
86
87$func Add-To-Label t.label e.name = t.label;
88
89$func Comp-Calls e.Re = e.calls;
90
91$func Prepare-Vars e.vars = e.vars;
92
93$func Prepare-Res e.Reult-exprs = e.Result-exprs;
94
95$func Comp-Assigns e.assignments = e.asail-assignments;
96
97$func Comp-Format (e.last-Re) e.He = e.assignments;
98
99
100
101************ Get AS-Items and targets, and pass it to Compile ************
102
103/*
104 * Ящик для объявлений статических функций, констант и объектов.  Все они
105 * выписываются в самом начале тела модуля.
106 */
107$box Declarations;
108
109RFP-Compile e.Items =
110  { <Lookup &RFP-Options ITEMS>;; } :: e.targets,
111  <RFP-Clear-Table &Stub-Funcs>,
112  <Store &Declarations /*empty*/>,
113  <Init-Consts>,
114  <Compile (e.targets) () e.Items> :: e.Items t.Interface,
115  <Comp-Func-Stubs> :: e.stub-funcs,
116  t.Interface (MODULE <? &Declarations> <Comp-Consts> e.Items e.stub-funcs);
117
118
119
120****************** Choose needed items and compile them ******************
121
122Compile (e.targets) (e.headers) e.Items, {
123  e.Items : e t.item e.rest,
124    {
125      e.targets : v =
126        e.targets : e t.name e,
127        t.item : (t t t t.name e);;
128    },
129    t.item : {
130      (IMPORT e) = () /*empty*/;
131      (s.link s.tag t.pragma t.name (e.in) (e.out) e.body), FUNC FUNC? : e s.tag e =
132        {
133          s.link : EXPORT = (DECL-FUNC t.name);
134          <Put &Declarations (DECL-FUNC t.name)> = /*empty*/;
135        } :: e.decl,
136        {
137          e.body : (BRANCH t.p e.branch) =
138            <Comp-Func s.tag t.name <Del-Pragmas (e.in) (e.out) e.branch>>;;
139        } :: e.comp-func,
140        (e.decl) e.comp-func;
141      (s.link CONST t.pragma t.name e.expr) =
142        (CONSTEXPR s.link t.name (e.expr) e.expr) :: t.const,
143        <Put &Declarations t.const>,
144        {
145          s.link : EXPORT = ((DECL-OBJ t.name)) /*empty*/;
146          () /*empty*/;
147        };
148      (EXPORT s.tag t.pragma t.name) =
149        <Put &Declarations (OBJ EXPORT s.tag t.name)>,
150        ((DECL-OBJ t.name)) /*empty*/;
151      (LOCAL  s.tag t.pragma t.name) =
152        <Put &Declarations (OBJ LOCAL s.tag t.name)>,
153        () /*empty*/;
154    } :: (e.decl) e.item =
155    e.item <Compile (e.targets) (e.headers e.decl) e.rest>;
156  /*<Comp-Func-Stubs>*/ (INTERFACE e.headers);
157};
158
159
160
161$func Gener-Stub e = e;
162
163/*
164 * For each referenced function generate a stub one with format e = e.
165 */
166Comp-Func-Stubs = <Map &Gener-Stub (<Domain &Stub-Funcs>)>;
167
168Gener-Stub (t.name) =
169  <Lookup &Stub-Funcs t.name> : t.stub-name s.tag (e.Fin) (e.Fout),
170  <Put &Declarations (DECL-FUNC t.stub-name)>,
171  <Gener-Vars (e.Fin) "stub"> :: e.He,
172  <Comp-Func s.tag t.stub-name ((EVAR ("arg" 1))) ((EVAR))
173    (LEFT e.He) (RESULT (CALL t.name e.He))>;
174
175
176
177Comp-Func s.tag t.name (e.in) (e.out) e.Sentence =
178  <RFP-Clear-Table &Labels>,
179  <RFP-Clear-Table &Prep-Vars>,
180  <Init-Vars>,
181  <Vars <Gener-Vars (e.out) "res">> :: e.res-vars,
182  <Vars-Decl e.res-vars> : e,
183  <Store &Res-Vars e.res-vars>,
184  <Store &Out-Format <Format-Exp e.out>>,
185  <Prepare-Res (e.in)> : (e.arg),
186  <Vars e.arg> :: e.arg-vars,
187  <Map &Set-Var- (Instantiated? True) (e.arg-vars)> : e,
188  s.tag : {
189    FUNC = FATAL;
190    FUNC? = RETFAIL;
191  } :: t.retfail,
192  (FUNC t.name (<Vars-Print e.arg-vars>) (<Vars-Print e.res-vars>)
193    <Comp-Sentence Tail ((t.retfail)) (e.arg) e.Sentence>
194  ) :: e.comp-func,
195*       <Set-Drops () <Gener-Var-Names e.comp-func>> :: t e.comp-func,
196  <Gener-Var-Names e.comp-func> :: e.comp-func,
197//!     <Post-Comp (e.res-vars) e.comp-func> :: t e.result,
198//!     e.result;
199  e.comp-func;
200//  :: (e.func-decl) e.func-body,
201//  () <Domain &Declarations> $iter {
202//    e.vars : (t.var) e.rest-vars,
203//      (e.var-decls (DECL t.var)) e.rest-vars;
204//  } :: (e.var-decls) e.vars,
205//  e.vars : /*empty*/,
206//  (e.func-decl e.var-decls e.func-body);
207
208Set-Drops (e.declared) e.comp-func =
209  e.comp-func () (e.declared) $iter {
210    e.comp-func : t.first e.rest, {
211      t.first : \{
212        (EXPR t.var e) = (DROP t.var) (t.first) t.var Init;
213        (DEREF t.var e) = (DROP t.var) (t.first) t.var Init;
214        (SUBEXPR t.var e) = (DROP t.var) (t.first) t.var Init;
215        (DECL Expr t.var) = (DROP t.var) () t.var Decl;
216        (DECL "int" t.var) = /*empty*/ () t.var Decl;
217      } :: e.drop (e.constr) t.var s.init,
218        {
219          e.declared : e1 t.var s.old-init e2, s.old-init : {
220            Init, {
221              t.var : (VAR ("const" e)) =
222                e.rest (e.result-func) (e.declared);
223              e.rest (e.result-func e.drop e.constr) (e.declared);
224            };
225            Decl, s.init : {
226              Decl =
227                e.rest (e.result-func) (e.declared);
228              Init =
229                t.first : (s.method t.var e.args),
230                e.rest (e.result-func (ASSIGN t.var (s.method e.args)))
231                (e1 e2 t.var s.init);
232                /*
233                 * FIXME: if s.method is EXPR, it shouldn't be written.
234                 */
235            };
236          };
237          e.rest (e.result-func t.first) (e.declared t.var s.init);
238        };
239      t.first : (LABEL (t.label) e.expr) =
240        <Set-Drops (e.declared) e.expr> :: (e.declared) e.expr,
241        e.rest (e.result-func (LABEL (t.label) e.expr)) (e.declared);
242      t.first : (e.expr) =
243        <Set-Drops (e.declared) e.expr> :: t e.expr,
244        e.rest (e.result-func (e.expr)) (e.declared);
245      t.first : s.symbol =
246        e.rest (e.result-func s.symbol) (e.declared);
247    };
248  } :: e.comp-func (e.result-func) (e.declared),
249  e.comp-func : /*empty*/ =
250  (e.declared) e.result-func;
251
252
253Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Sentence, e.Sentence : {
254
255  /*empty*/ = /*empty*/;
256
257  /*
258   * In case of Re look if we should do a tailcall.  If not, then compile
259   * function calls from the Re and assign results to the out parameters or
260   * use them in compilation of the rest of the sentence.
261   */
262  (RESULT e.Re) e.Snt =
263    {
264      /*
265       * If the Re is the last action in the sentence then we can do
266       * tailcall if one of the following is true:
267       *  - Re is a call of non-failable function;
268       *  - Re is a call of a failable function, current function is
269       *  failable, and the failures stack is empty.
270       * In both cases out format of the called function should coincide
271       * with those of compiled one.
272       * FIXME: really we can do tailcall if all the parameters of
273       * compiled function that won't get their values from the call can
274       * be assigned from other sources.  Some support from runtime is
275       * needed though.
276       */
277      e.Snt : /*empty*/, s.tail? : Tail, e.Re : (CALL t.name e.arg),
278        { <In-Table? &Fun? t.name> = v.fails : (RETFAIL);; },
279        <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
280        <Subformat? (e.Fout) (<? &Out-Format>)> =
281        <Extract-Calls e.arg> :: (e.last-Re) e.calls,
282        <Prepare-Res <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
283        <Comp-Calls <R 0 v.fails> e.calls>
284        (TAILCALL t.name (e.splited-Re) (<? &Res-Vars>));
285
286      <Extract-Calls e.Re> :: (e.last-Re) e.calls,
287        <Comp-Calls <R 0 v.fails> e.calls> :: e.comp-calls,
288        {
289          e.Snt : /*empty*/, s.tail? : Tail =
290            <Split-Re (<? &Out-Format>) e.last-Re> :: e.splited-Re,
291            <Prepare-Res e.splited-Re> :: e.splited-Re,
292            e.comp-calls <Comp-Assigns <Zip (<? &Res-Vars>) (e.splited-Re)>>;
293
294          e.comp-calls <Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Snt>;
295        };
296    };
297
298  /*
299   * In case of He compile assignments from last Re and then (with new state
300   * of variables) proceed with the rest of the sentence.
301   */
302  (FORMAT e.He) e.Snt =
303    <Comp-Format (e.last-Re) e.He>
304    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
305
306  /*
307   * In case of Pe get from the begining of the sentence a maximum possible
308   * sequence of clashes and compile it.  New values of variables from the
309   * clashes use in the compilation of the rest of the sentence.
310   */
311  (s.dir e.Pattern) e.Snt, s.dir : \{ LEFT; RIGHT; } =
312    <Get-Clash-Sequence (e.last-Re) e.Sentence> :: (e.clashes) e.Sentence,
313    <Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence>;
314
315  (s.block) e, BLOCK BLOCK? : e s.block e = <WriteLN! &StdErr "Empty block?">, $fail;
316
317  /*
318   * In case of a block first see if its results are needed for something
319   * after the block and determine whether the block is a source.  Then
320   * compile each branch in turn.
321   */
322  (s.block e.branches) e.Snt,
323    s.block : \{
324      BLOCK = (FATAL);
325      BLOCK?;
326    } :: e.fatal? =
327    /*
328     * If the block initializes an $iter then extract from the $iter the He
329     * for placing it in the end of each branch.
330     * Then look if the block is used by a pattern or format expression.
331     * If so, we should declare variables from that expression before
332     * entering any branch -- those should be visible after the block.
333     * Pattern or format expression is placed in the end of each branch.
334     * But if a branch computes to $error, the expression shouldn't be
335     * used, so protect it with (Comp If-not-error).
336     * If next after the block is (Comp Error) then block results should be
337     * used as values for $error, so place (Comp Error) in the end of each
338     * branch.
339     * If next after the block is (Comp If-not-error) then our block is in
340     * the end of a branch of an outer block and has next pattern or format
341     * inherited from there.  In that case we should place all the sentence
342     * rest in the end of each branch because the block can be inside the
343     * $error already.
344     */
345    {
346      e.Snt : (ITER t.body t.format t.cond) e.rest =
347        t.format (Comp Iter t.body t.format t.cond) e.rest;
348      e.Snt;
349    } :: e.Snt,
350    e.Snt : {
351      t.first e.rest, t.first : \{
352        (LEFT e.pattern) = e.pattern;
353        (RIGHT e.pattern) = e.pattern;
354        (FORMAT e.format) = e.format;
355      } :: e.expr =
356        <Prepare-Vars <Vars e.expr>> :: e.vars,
357        (e.vars) ((Comp If-not-error) t.first)
358        ((Comp Source)) e.rest;
359      (Comp Error) e.rest =
360        () ((Comp Error)) () /*empty*/;
361      (Comp If-not-error) e.rest =
362        () (e.Snt) () /*empty*/;
363      e = () () () e.Snt;
364    } :: (e.out-vars) (e.next-terms) (e.source?) e.Snt,
365    /*
366     * The block is a source if after it goes pattern or format expression
367     * (in that case e.source? isn't empty) or e.Snt isn't empty.
368     * Branches in the block are tail sentences if the current sentence is
369     * tail and the block isn't a source.
370     */
371    {
372      \{ e.source? : v; e.Snt : v; } = ((Comp Source) <R 0 v.fails>) Notail;
373      s.tail? : Tail = () Tail;
374      () Notail;
375    } :: (e.source?) s.tail-branch?,
376    /*
377     * In case our block is a source we should mark the position in the
378     * failures stack, so that we can jump to it after CUTALL.  And if our
379     * block isn't failable we should add (FATAL) to the end of the stack.
380     */
381    v.fails e.source? e.fatal? :: v.branch-fails,
382    /*
383     * Before compile the branches mark all out-vars as declared.
384     */
385    <Vars-Decl e.out-vars> :: e.decls,
386    /*
387     * We put all compiled branches in a block, so positive return from a
388     * branch is a break from that block.
389     * Each branch in its turn is placed in its own block, so for a $fail
390     * to the next branch we should just break from that inner block.
391     * Each branch is compiled with the current sentence state and the
392     * state is recalled after that.  When all branches are compiled the
393     * state is popped out from the stack.
394     * If last branch fails then the whole block fails, and return from the
395     * last branch is return from the block.  So the last branch isn't
396     * placed in a block and is processed with the failures stack that was
397     * before entering the block.  Note: this trick helps us find more
398     * tailcalls.  If the call of a failable function is on the last branch
399     * of the block and the failures stack is empty we can do tailcall.
400     * When the last branch is compiled with the block's stack, all we
401     * should do is to check it.
402     */
403    <Gener-Label "block"> :: t.label,
404    <Save-Snt-State>,
405    (e.branches) /*e.comp-branches*/ $iter {
406      e.branches : (BRANCH e.branch) e.rest-br =
407        <Add-To-Label t.label "branch"> :: t.br-label,
408        <Comp-Sentence
409          s.tail-branch?
410          (v.branch-fails ((BREAK t.br-label)))
411          (e.last-Re)
412          e.branch e.next-terms
413        > :: e.comp-br,
414        <Recall-Snt-State>,
415        (e.rest-br) e.comp-branches (LABEL (t.br-label) e.comp-br (BREAK t.label));
416    } :: (e.branches) e.comp-branches,
417    e.branches : (BRANCH e.branch) =
418    <Comp-Sentence
419      s.tail-branch? (v.branch-fails) (e.last-Re) e.branch e.next-terms
420    > :: e.last-branch,
421    <Pop-Snt-State>,
422    <Map &Set-Var- (Instantiated? True) (e.out-vars)> : e,
423    e.decls (LABEL (t.label) e.comp-branches e.last-branch)
424    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
425
426  /*
427   * In case of $iter first of all compile initial assignment to the hard
428   * expression.
429   */
430  (ITER t.body t.format t.cond) e.Snt =
431    <Comp-Sentence s.tail? (v.fails) (e.last-Re)
432      t.format (Comp Iter t.body t.format t.cond) e.Snt
433    >;
434
435  /*
436   * Before compiling $iter condition or body we should forget available info
437   * about all format variables, because that info can be changed during
438   * cycle iterations.
439   * Then compile $iter condition and body both with the current state of the
440   * sentence.
441   * e.Snt can contain (Comp Error) and (protected from errors) pattern or
442   * format which comes from an outer block, so compile it together with the
443   * condition.
444   * If condition fails we should compute the body, so put the compiled
445   * condition in a block and place a break from it to the failures stack.
446   */
447  (Comp Iter (BRANCH e.body) t.format (BRANCH e.condition)) e.Snt =
448    t.format : (FORMAT e.Fe),
449    <Vars-Reset <Prepare-Vars <Vars e.Fe>>>,
450    <Save-Snt-State>,
451    <Gener-Label "iter"> :: t.label,
452    <Gener-Label "exit_iter"> :: t.exit,
453    <Comp-Sentence s.tail? (v.fails ((BREAK t.label))) () e.condition e.Snt>
454      :: e.comp-condition,
455    <Pop-Snt-State>,
456    <Comp-Sentence Notail (v.fails) () e.body t.format> :: e.comp-body,
457    (FOR (/*cont-label*/) (t.exit) () ()
458      (LABEL (t.label) e.comp-condition (BREAK t.exit)) e.comp-body
459    );
460
461  /*
462   * In case of $trap/$with at first compile try-sentence.  All $fails from
463   * it should become errors.
464   * Then recall the state of the sentence and compile catching of an error
465   * with a variable err.
466   * e.Snt can contain (Comp Error) and (protected from errors) pattern or
467   * format which comes from an outer block, so compile it together with both
468   * sentences.
469   */
470  (TRY (BRANCH e.try) e.catch) e.Snt =
471    <Save-Snt-State>,
472    <Comp-Sentence Notail ((FATAL)) () e.try e.Snt> :: e.comp-try,
473    <Pop-Snt-State>,
474    <Gener-Err-Var> :: t.var,
475    <Set-Var (Instantiated? True) t.var>,
476    <Comp-Sentence s.tail? (v.fails) (t.var) e.catch e.Snt> :: e.comp-catch,
477    (TRY e.comp-try) (CATCH-ERROR e.comp-catch);
478
479  /*
480   * In case of \? add Stake to the failures stack.  Add last fail after it
481   * for <R 0 v.fails> continue to work.
482   */
483  (STAKE) e.Snt =
484    <Comp-Sentence s.tail? (v.fails (Comp Stake) <R 0 v.fails>) () e.Snt>;
485
486  /*
487   * In case of \! forget all failure catchers after last \?.
488   * If there is no Stake then we are inside negation or error (we assume the
489   * program is correct).  So the right failure catcher is in the bottom of
490   * the stack.
491   */
492  (CUT) e.Snt =
493    {
494      v.fails : $r v.earlier-fails (Comp Stake) e = v.earlier-fails;
495      <L 0 v.fails>;
496    } :: v.fails,
497    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
498
499  /*
500   * In case of = clear the failures stack up to the closest source.
501   */
502  (CUTALL) e.Snt =
503    {
504      v.fails : $r v.earlier-fails (Comp Source) e = v.earlier-fails;
505      <L 0 v.fails>;
506    } :: v.fails,
507    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
508
509  /*
510   * In case of = in the Refal-6 sense (non-transparent hedge for the fails),
511   * $fail(k) should become $error(Fname "Unexpected fail"), so clear the
512   * failures stack and put that value in it.
513   */
514  NOFAIL e.Snt =
515    <Comp-Sentence s.tail? ((FATAL)) (e.last-Re) e.Snt>;
516
517  /*
518   * In case of $fail return last failure catcher.
519   */
520  (FAIL) e.Snt =
521    v.fails : e (e.last-fail),
522    e.last-fail;
523
524  /*
525   * In case of # we should proceed with the rest if the source is computed
526   * to $fail.
527   * We could compile the rest of the sentence and place it in the
528   * failures stack.  But then the compiled sentence would be copied as many
529   * times as there are $fail's to the upper level in the source.  So we
530   * place compiled source in the block and put the break to exit from it in
531   * the stack.
532   * When compiling the source mark it as Notail as usual.
533   * If the source isn't computed to $fail we should proceed with the last
534   * failure catcher.
535   */
536  (NOT (BRANCH e.branch)) e.Snt =
537    <Gener-Label "negation"> :: t.label,
538    v.fails : e (e.last-fail),
539//    <Save-Snt-State>,
540    <Comp-Sentence Notail (((BREAK t.label))) () e.branch> e.last-fail
541      :: e.comp-negation,
542//    <Pop-Snt-State>,
543    (LABEL (t.label) e.comp-negation) <Comp-Sentence s.tail? (v.fails) () e.Snt>;
544
545  /*
546   * In case of $error all fails become $error(Fname "Unexpected fail").  So
547   * place that value in the failures stack and then compile the computation
548   * of the rest of the sentence and the last Re which should be the value of
549   * $error.
550   */
551  (ERROR) e.Snt =
552    <Comp-Sentence Notail ((FATAL)) () e.Snt (Comp Error)>;
553
554  (Comp Error) e.Snt =
555    <Prepare-Res (e.last-Re)> : (e.Re),
556    (ERROR e.Re);
557
558  /*
559   * Protection mark to be used between source and tail.  If there is $error
560   * construction somewhere in the source then the tail shouldn't be
561   * computed, but instead the source value should be used for throwing.
562   */
563  (Comp If-not-error) e.Snt =
564    {
565      e.Snt : e (Comp Error) =
566        <Comp-Sentence s.tail? (v.fails) (e.last-Re) (Comp Error)>;
567      <Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Snt>;
568    };
569
570//  (Comp Fatal) = FATAL;
571
572//  (Comp Retfail) = RETFAIL;
573
574};
575
576
577
578********** Sentence state stack and functions for work with it. **********
579
580$box Snt-State;
581
582/*
583 * Put current state in the stack.
584 */
585Save-Snt-State = <Put &Snt-State <Vars-Copy-State>>;
586
587/*
588 * Set current state to that at the top of the stack.
589 */
590Recall-Snt-State = <Vars-Set-State <R 0 <? &Snt-State>>>;
591
592/*
593 * Pop the top from the stack and set current state to it.
594 */
595Pop-Snt-State =
596  <Recall-Snt-State>,
597  <Store &Snt-State <Middle 0 1 <? &Snt-State>>>;
598
599
600
601********************** Function calls compilation. ***********************
602
603/*
604 * $func Extract-Calls e.Re = (e.last-Re) e.calls;
605 *
606 *
607 *
608 */
609Extract-Calls {
610  (CALL t.name e.arg) e.rest =
611    <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
612    <Extract-Calls e.arg> :: (e.last-Re) e.calls,
613    <Prepare-Res <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
614    <RFP-Extract-Qualifiers t.name> :: t e.prefix,
615    <Gener-Subst-Vars (e.Fout) e.prefix> :: e.Re,
616    <Vars e.Re> :: e.vars,
617    <Map &Set-Var- (Instantiated? True) (e.vars)> : e,
618    {
619      s.tag : FUNC? =   (Failable (CALL t.name (e.splited-Re) (e.vars)));
620      (CALL t.name (e.splited-Re) (e.vars));
621    } :: t.call,
622    <Extract-Calls e.rest> :: (e.rest-Re) e.rest-calls,
623    (e.Re e.rest-Re) e.calls <Vars-Decl e.vars> t.call e.rest-calls;
624  (PAREN e.Re) e.rest =
625    <Extract-Calls e.Re> :: (e.last-Re) e.calls,
626    <Extract-Calls e.rest> :: (e.rest-Re) e.rest-calls,
627    ((PAREN e.last-Re) e.rest-Re) e.calls e.rest-calls;
628  t.Rt e.Re =
629    <Extract-Calls e.Re> :: (e.last-Re) e.calls,
630    (t.Rt e.last-Re) e.calls;
631  /*empty*/ = () /*empty*/;
632};
633
634
635Comp-Calls (e.fail) e.calls, e.calls : {
636  (Failable t.call) e.rest =
637    (IF ((NOT t.call)) e.fail) <Comp-Calls (e.fail) e.rest>;
638  t.call e.rest =
639    t.call <Comp-Calls (e.fail) e.rest>;
640  /*empty*/ = /*empty*/;
641};
642
643
644
645********** Preparation of vars and REs for following processing **********
646*********** Compilation of static parts of result expressions ************
647
648$func Static-Expr? s.create? e.Re = static? e.Re;
649
650$func Static-Term? t.Rt = static? t.Rt;
651
652$func Find-Ref-Funcs expr = expr;
653
654$func Stub-Name t.name = t.stub-name;
655
656
657/*
658 * Extract static parts from each Re.
659 * Also get the right names for variables generated during the preprocessing
660 * stage, if those are in the expr.
661 */
662Prepare-Res {
663  (e.Re) e.rest = <Static-Expr? Create e.Re> :: s e.Re, (e.Re) <Prepare-Res e.rest>;
664  /*empty*/     = /*empty*/;
665};
666
667/*
668 * Find all the longest static parts in the upper level of Re.  Create STATIC
669 * form in place of each one.
670 * Return a tag pointing whether the whole expression is static and expression
671 * with static parts replaced by STATIC forms.  Dynamic parts are returned
672 * unchanged.
673 */
674Static-Expr? {
675  s.create? t.Rt e.Re =
676    <Static-Term? t.Rt> : {
677      Static t.st-Rt =
678        {
679          e.Re : e1 t2 e3, <Static-Term? t2> : Dynamic t.dyn-Rt =
680            <Static-Expr? Create e3> :: s e3,
681            Dynamic
682            <Create-Static <Find-Ref-Funcs t.st-Rt e1>> t.dyn-Rt e3;
683          {
684            s.create? : Create =
685              Static
686              <Create-Static <Find-Ref-Funcs t.st-Rt e.Re>>;
687            Static <Find-Ref-Funcs t.st-Rt e.Re>;
688          };
689        };
690      Dynamic t.dyn-Rt =
691        <Static-Expr? Create e.Re> :: s e.Re,
692        Dynamic t.dyn-Rt e.Re;
693    };
694  s.create? /*empty*/ = Static;
695};
696
697
698/*
699 * The same as Static-Expr? but for terms.
700 */
701Static-Term? {
702  symbol       = Static symbol;
703  (PAREN e.Re) = <Static-Expr? Not-Create e.Re> :: static? e.Re, static? (PAREN e.Re);
704  (REF t.name) = Static (REF t.name);
705  t.var        = <Prepare-Vars t.var> : t.prep-var, Dynamic t.prep-var;
706};
707
708
709Prepare-Vars {
710  (s.var-tag (e.prefix s.n)) e.rest, <Int? s.n> =
711    {
712      <Lookup &Prep-Vars e.prefix s.n>;
713      <Gener-Vars ((s.var-tag)) e.prefix> :: e.var,
714        <Bind &Prep-Vars (e.prefix s.n) (e.var)>,
715        e.var;
716    } :: e.var,
717    e.var <Prepare-Vars e.rest>;
718  t.var e.rest = t.var <Prepare-Vars e.rest>;
719  /*empty*/ = /*empty*/;
720};
721
722
723$func Ref-Func? e = e;
724
725Find-Ref-Funcs expr = <Map &Ref-Func? (expr)>;
726
727Ref-Func? {
728  (REF t.name) =
729    {
730      <Lookup-Func t.name> : {
731        t t t ((EVAR)) ((EVAR)) = (FUNC t.name);
732        s.linkage s.tag t.pragma (e.Fin) (e.Fout) =
733          {
734            <Lookup &Stub-Funcs t.name> : t.stub-name e =
735              (FUNC t.stub-name);
736            <Stub-Name t.name> :: t.stub-name,
737              <Bind &Stub-Funcs (t.name)
738                (t.stub-name s.tag (e.Fin) (e.Fout))>,
739              (FUNC t.stub-name);
740          };
741      };
742      (REF t.name);
743    };
744  term = term;
745};
746
747
748/*
749 * Генерируем уникальные внутри модуля имена для функций-заглушек.
750 */
751Stub-Name (e.qualifiers s.name) =
752  <To-Chars s.name> : {
753    e1 '_' s.n, <Int? s.n> = e1 '_' <"+" s.n 1>;
754    e1 = e1 '_' 0;
755  } :: e.name,
756  (e.qualifiers <To-Word e.name>) :: t.name,
757  {
758    <Lookup-Func t.name> : e = <Stub-Name t.name>;
759    t.name;
760  };
761
762
763
764***************** Compilation of assignment to variables *****************
765
766$func Comp-Assign-to-Var e = e;
767
768Comp-Assign-to-Var (t.var (e.Re)) =
769  {
770    t.var : e.Re = /*empty*/;
771    <Set-Var (Instantiated? True) t.var>, $fail;
772    <Substitutable-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
773    <Get-Var Decl t.var> : s = (ASSIGN <Vars-Print t.var> e.Re);
774    <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
775  };
776
777Comp-Assigns e.assigns = <Map &Comp-Assign-to-Var (e.assigns)>;
778
779
780
781************************** FORMAT compilation. ***************************
782
783$box Aux-Index;
784
785$func Gener-Aux-Var = t.new-aux-var;
786
787Gener-Aux-Var =
788  <? &Aux-Index> : s.n,
789  <Store &Aux-Index <"+" s.n 1>>,
790  (VAR ("aux" s.n));
791
792
793$func Create-Aux-Vars (e.vars) e.splited-Re = e.assigns;
794
795
796Comp-Format (e.last-Re) e.He =
797  <Prepare-Vars <Vars e.He>> :: e.vars,
798  <Prepare-Res <Split-Re (<Format-Exp e.He>) e.last-Re>> :: e.splited-Re,
799  <Store &Aux-Index 1>,
800  <Create-Aux-Vars (e.vars) e.splited-Re> :: e.assigns,
801  <Comp-Assigns e.assigns>;
802
803/*
804 * Итак, e.vars -- все переменные, входящие в форматное выражение.  Каждая
805 * переменная может входить в форматное выражение только один раз, поэтому
806 * повторяющихся среди них нет.
807 * e.splited-Re -- набор результатных выражений.  На каждую переменную из
808 * e.vars по выражению, которое должно быть ей присвоено.
809 *
810 * Если переменная t.var_i используется в выражении e.Re_j, и i /= j, то
811 * переменной t.var_j значение должно быть присвоено раньше, чем перeменной
812 * t.var_i.  Если же, по аналогичным соображениям, t.var_i должна получить
813 * значение раньше t.var_j, необходимо завести вспомогательную переменную.
814 *
815 * Пример:
816 *
817 * t1 (t1 t2) (t1 t3) :: t2 t1 t3
818 *
819 * t3 = (t1 + t3)();
820 * aux_1 = t1;
821 * t1 = (t1 + t2)()
822 * t2 = aux_1;
823 *
824 * В общем случае вспомогательная переменная требуется, если двум переменным
825 * необходимы старые значения друг друга (возможно, не напрямую, а через
826 * промежуточные переменные).
827 *
828 * Вместо того, чтобы искать и анализировать такие циклы, будем действовать по
829 * методу "наибольшей пользы".  А именно:
830 *
831 *   - Для каждой переменной выпишем все другие переменные, которым требуется
832 *     её старое значение, а также отдельно те, старые значения которых
833 *     требуются ей.
834 *
835 *   - Всем переменным, от старых значений которых ничего не зависит, можно
836 *     смело присвоить новые значения.  При этом они исчезают из списков
837 *     зависимостей оставшихся переменных.
838 *
839 *   - Все переменные, новые значения которых ни от чего не зависят, можно
840 *     отложить, чтобы присвоить им значения тогда, когда будет удобно.  Т.е.
841 *     тогда, когда списки зависящих от них переменных опустеют.
842 *
843 *   - Чтобы означить оставшиеся, нужны вспомогательные переменные.  Выберем
844 *     одну из переменных, с максимальным списком тех, от которых она зависит,
845 *     и положим её значение во вспомогательную переменную.  Так как мы сразу
846 *     уменьшили кол-во зависимостей у максимального кол-ва переменных,
847 *     локально мы добились наибольшей пользы, хотя не исключено, что глобально
848 *     такой метод и не даст наименьшего кол-ва вспомогательных переменных.
849 *     Кроме того, мы не пытаемся выбрать наилучшую переменную из нескольких с
850 *     максимальным списком зависимостей.
851 *
852 *   - Повторяем всё это до тех пор, пока у каждой переменной не опустеет
853 *     список зависящих от неё.
854 *
855 *
856 * Для нашего примера:
857 *
858 * t1 (t1 t2) (t1 t3) :: t2 t1 t3
859 *
860 * t1 -- (t2 t3) (t2)
861 * t2 -- (t1)    (t1)
862 * t3 -- ()      (t1)
863 *
864 *
865 * Для каждой переменной var_i найдём все j /= i, такие что в Re_j встречается
866 * var_i -- provide[i], и а также все j /= i, такие что var_j нужна для
867 * подсчёта var_i, т.е. встречается в Re_i.
868 *
869 * Res-vars <- <Map &Vars (Res)>
870 * for var_i in vars
871 *     provide[i] <-
872 *     for vars-Re_j in Res-vars, j /= i
873 *         vars-Re_j : e var_i e = j
874 *     require[i] <- <Res-vars[i] `*` vars[^i]> : e var_j e, j
875 *
876 * Res-vars = map Vars Res
877 * provide, require =
878 *   {   [ j | vars-Re_j <- Res-vars, j /= i, var_i `in` vars-Re_j ]
879 *     , [ j | var_j <- Res-vars[i] `*` vars, i /= j]
880 *     | var_i <- vars
881 *   }
882 *
883 */
884
885$func CAV e.vars (e.assigns) (e.delayed) = e.assigns;
886
887$func Get-Vars e = e;
888Get-Vars (e.Re) = (<Vars e.Re>);
889
890Create-Aux-Vars (e.vars) e.splited-Re =
891  <Zip (<Map &Get-Vars (e.splited-Re)>) (e.vars)> :: e.list,
892  <Box> :: s.box,
893  <Box> :: s.provide-i,
894  <Box> :: s.require-i,
895  {
896    e.vars : e1 t.var-i e2,
897      {
898        e.list : e ((e.vars-Re) t.var-j) e,
899          \{
900            t.var-i : t.var-j = <Put s.require-i <And (e1 e2) e.vars-Re>>;
901            e.vars-Re : e t.var-i e = <Put s.provide-i t.var-j>;
902          },
903          $fail;
904        <L <Length e1> e.splited-Re> :: t.Re-i,
905        <Put s.box (t.var-i t.Re-i (<? s.provide-i>) (<? s.require-i>))>,
906          <Store s.provide-i /*empty*/>,
907          <Store s.require-i /*empty*/>;
908      },
909      $fail;;
910  },
911  <CAV <? s.box> (/*assigns*/) (/*delayed*/)>;
912
913
914/*
915 * Если есть переменная, у которой список provide пуст, её можно посчитать.
916 * Это выражается в том, что она (вместе с присваиваемым значением) добавляется
917 * в список assigns, убирается из списка vars, а также из всех списков provide
918 * и delayed.  В списках require её не было.
919 *
920 * CAV Res vars provide require assigns delayed =
921 *   { i | var_i <- vars, provide_i == [] } ->     // Здесь неверно!  На переменные
922 *                                                    из delayed тоже надо смотреть.
923 *       vars    = vars - var_i
924 *       provide = [ provide_j - i | provide_j <- provide ]
925 *       assigns = assigns++[(var_i, Res[i])]
926 *       delayed = [ (var_j, provide_j - i) | (var_j, provide_j) <- delayed ]
927 *       CAV Res vars provide require assigns delayed
928 */
929
930$func Assign-Empty-Provides e.vars  = e.assigns (e.vars);
931
932Assign-Empty-Provides {
933  e1 (t.var-i t.Re-i (/*empty provide_i*/) (e.require-i)) e2 =
934    <Box> :: s.vars,
935    {
936      e1 e2 : e (t.var-j t.Re-j (e.provide-j) (e.require-j)) e,
937        <Put s.vars (t.var-j t.Re-j (<Sub (e.provide-j) t.var-i>) (e.require-j))>,
938        $fail;;
939    },
940    (t.var-i t.Re-i) <Assign-Empty-Provides <? s.vars>>;
941  e.vars = /*empty*/ (e.vars);
942};
943
944
945/*
946 * Если есть переменная, у которой список require пуст, кладём её в delayed.
947 * Она будет посчитана, когда у неё опустеет список provide, т.е. когда не
948 * останется переменных, у которых она в списке require.
949 */
950$func Delay-Empty-Requires e.vars  = e.delayed (e.vars);
951
952Delay-Empty-Requires {
953  e1 t.var e2, t.var : (t.var-i t.Re-i (e.provide-i) (/*empty require_i*/)) =
954    <Delay-Empty-Requires e2> :: e.delayed (e.vars),
955    t.var e.delayed (e1 e.vars);
956  e.vars = /*empty*/ (e.vars);
957};
958
959
960/*
961 * Выбор переменной (из двух) с более длинным списком требуемых ей значений.
962 */
963$func Max-Require e = e;
964
965Max-Require t.arg1 t.arg2 =
966  t.arg1 : (t.var1 t.Re1 t.provide1 (e.require1)),
967  t.arg2 : (t.var2 t.Re2 t.provide2 (e.require2)),
968  {
969    <"<" (<Length e.require1>) (<Length e.require2>)> = t.arg2;
970    t.arg1;
971  };
972
973
974/*
975 * Подставить вспомогательную переменную вместо исходной во всех результатных выражениях.
976 * Присваивание к исходной переменной убрать (оно к этому моменту уже выполнено).
977 * Убрать переменную из списков зависимостей.
978 */
979$func Subst-Aux-Var e = e;
980
981Subst-Aux-Var t.var t.aux (t.v t.Re (e.provide) (e.require)), {
982  t.var : t.v = /*empty*/;
983  (
984    t.v
985    <Subst (t.var) ((t.aux)) t.Re>
986    (<Sub (e.provide) t.var>)
987    (<Sub (e.require) t.var>)
988  );
989};
990
991
992/*
993 * Извлечь присваивание из всей информации о переменной.
994 */
995$func Extract-Assigns e = e;
996Extract-Assigns (t.var t.Re e) = (t.var t.Re);
997
998
999/*
1000 * Основной цикл обработки присваиваний.
1001 *
1002 * 1) Из всех переменных (в том числе и отложенных), от которых больше ничего
1003 *    не зависит, сделать присваивания.
1004 * 2) Все переменные, которые больше ни от чего не зависят, отложить.
1005 * 3) Если осталось хотя бы две неотложенных переменных, выбирать из них ту,
1006 *    которая зависит от наибольшего числа переменных, подставить везде вместо
1007 *    неё вспомогательную, перейти к пункту 1.
1008 */
1009CAV e.vars (e.assigns) (e.delayed) =
1010  <Assign-Empty-Provides e.vars> :: e.new-assigns (e.vars),
1011  e.assigns e.new-assigns <Assign-Empty-Provides e.delayed> :: e.assigns (e.delayed),
1012  e.delayed <Delay-Empty-Requires e.vars> :: e.delayed (e.vars),
1013  {
1014    e.vars : t t e =
1015      <Foldr1 &Max-Require (e.vars)> : (t.var t.Re e),
1016      <Gener-Aux-Var> :: t.aux,
1017      e.assigns (t.aux (t.var)) (t.var t.Re) :: e.assigns,
1018      <Map &Subst-Aux-Var t.var t.aux (e.vars)> :: e.vars,
1019      <Map &Subst-Aux-Var t.var t.aux (e.delayed)> :: e.delayed,
1020      <CAV e.vars (e.assigns) (e.delayed)>;
1021    e.assigns <Map &Extract-Assigns (e.vars e.delayed)>;
1022  };
1023
1024
1025
1026
1027****************** Компиляция сопоставления с образцом *******************
1028
1029Get-Clash-Sequence (e.last-Re) t.Pattern e.Snt =
1030  (/*e.clashes*/) (RESULT e.last-Re) t.Pattern e.Snt $iter {
1031    e.Snt : (RESULT e.Re) (s.dir e.Pe) e.rest =
1032      /*
1033       * Компилируем все константные выражения и заводим в табличке все
1034       * незаведённые переменные.  У старых переменных очищается память
1035       * на предмет клешей, в которых они раньше использовались.
1036       */
1037      <Prepare-Res (e.Re) (e.Pe)> : (e.R1) (e.P1),
1038      <Map &Set-Var- (Clashes /*empty*/) (<Vars e.R1 e.P1>)> : e,
1039      (e.clashes (e.R1) (s.dir e.P1)) e.rest;
1040  } :: (e.clashes) e.Snt,
1041  # \{
1042    e.Snt : \{
1043      (RESULT e.Re) (LEFT e) e = e.Re;
1044      (RESULT e.Re) (RIGHT e) e = e.Re;
1045    } :: e.Re,
1046      <Without-Calls? e.Re>;
1047  } =
1048  (e.clashes) e.Snt;
1049
1050Without-Calls? e.Re =
1051  e.Re $iter {
1052    e.Re : t.Rt e.rest =
1053      t.Rt : {
1054        (CALL e) = $fail;
1055        (BLOCK e) = $fail;
1056        (PAREN e.Re1) = <Without-Calls? e.Re1>;
1057        t.symbol-or-var = /*empty*/;
1058      },
1059      e.rest;
1060  } :: e.Re,
1061  e.Re : /*empty*/;
1062
1063$func CC s.tail? (v.fails) t.end-cycle e.Snt = e.asail-Snt;
1064
1065Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence =
1066  <Init-Clashes e.clashes>,
1067  <CC s.tail? (v.fails) <R 0 v.fails> e.Sentence>;
1068
1069$func CC-Known-Lengths t.fail e.idxs = e.conds;
1070
1071$func CC-Compute-Length t.fail t.end-cycle t.idx = e;
1072
1073$func CC-Unknown-Lengths t.fail e.idxs = e.conds;
1074
1075$func CC-Deref t.fail e.actions = e.actions;
1076
1077$func CC-Eqs t.fail (e.assigns) e.eqs = e.actions;
1078
1079CC s.tail? (v.fails) t.end-cycle e.Snt, {
1080  <Domain &Known-Lengths> : v.clashes =
1081    <CC-Known-Lengths t.end-cycle v.clashes>
1082    <CC s.tail? (v.fails) t.end-cycle e.Snt>;
1083  <Domain &Compute-Length> : (t.clash) e =
1084    <CC-Compute-Length <R 0 v.fails> t.end-cycle t.clash>
1085    <CC s.tail? (v.fails) t.end-cycle e.Snt>;
1086  <Domain &Unknown-Lengths> : e.clashes =
1087    <CC-Unknown-Lengths t.end-cycle e.clashes> :: e.conds,
1088    /*
1089     * Когда мы добрались до сюда, все условия на длины на текущем уровне
1090     * выписаны.  Невыполнение любого из оставшихся условий (на
1091     * соответствие типов, равенство, длины внутри скобок) ведёт не к
1092     * прекращению текущего цикла, а переход к его следующей итерации.
1093     * Поэтому в качестве t.end-cycle везде дальше подставляется текущий
1094     * откат.
1095     */
1096    <Update-Hard-Parts> : {
1097      v.actions =
1098        e.conds <CC-Deref <R 0 v.fails> v.actions>
1099        <CC s.tail? (v.fails) <R 0 v.fails> e.Snt>;
1100      /*empty*/ =
1101        e.conds <CC-Eqs <R 0 v.fails> () <? &Eqs>> :: e.actions,
1102        <Store &Eqs /*empty*/>,
1103        {
1104          <Compose-Source> :: e.assign =
1105            e.actions <CC-Eqs <R 0 v.fails> () e.assign>
1106            <CC s.tail? (v.fails) <R 0 v.fails> e.Snt>;
1107          {
1108            <Get-Cycle> :: s.split (e.left) (e.right) (e.len)
1109                    t.var t.l-var t.r-var =
1110              {
1111                e.left : 0, e.right : 0 = /*empty*/ t.var;
1112                <Gener-Vars ((VAR)) "subexpr_" t.var> : t.sub-var,
1113                  (SUBEXPR t.sub-var t.var (e.left)
1114                    ((INFIX "-" (e.len) (e.left e.right))))
1115                  t.sub-var;
1116              } :: e.subexpr t.var,
1117              {
1118                s.split : RSPLIT =
1119                  t.r-var t.l-var DEC-ITER;
1120                t.l-var t.r-var INC-ITER;
1121              } :: t.l-var t.r-var s.iter-op,
1122              <Gener-Label "continue"> :: t.cont-label,
1123              <Gener-Label "exit"> :: t.break-label,
1124              e.actions e.subexpr
1125              (s.split t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
1126              (FOR (t.cont-label) (t.break-label) () ((s.iter-op t.var))
1127                (IF ((NOT (CHECK-ITER t.var))) <Concat <R 0 v.fails>>)
1128                <CC s.tail?     (v.fails ((CONTINUE t.cont-label)))
1129                  <R 0 v.fails> e.Snt>
1130                (BREAK t.break-label)
1131              );
1132            e.actions <Comp-Sentence s.tail? (v.fails) () e.Snt>;
1133          };
1134        };
1135    };
1136};
1137
1138CC-Known-Lengths (e.fail) e.idxs, {
1139  e.idxs : (t.idx) e.rest =
1140    <Put &Checked-Lengths t.idx>,
1141    <Lookup &Known-Lengths t.idx> : (e.len-Re) (e.len-Pe),
1142    (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
1143    <CC-Known-Lengths (e.fail) e.rest>;
1144  <RFP-Clear-Table &Known-Lengths>;
1145};
1146
1147CC-Compute-Length (e.fail) (e.end-cycle) t.idx =
1148  <Lookup &Compute-Length t.idx> : t.var s.mult (e.minuend) (e.subtrahend),
1149  <Create-Int-Var ("len") Aux e.minuend> :: t.m-var e.m-assign,
1150  <Create-Int-Var ("len") Aux e.subtrahend> :: t.s-var e.s-assign,
1151  <Get-Var Min t.var> :: e.min,
1152  ((INFIX "<" (t.m-var)
1153        ((INFIX "+" (t.s-var)
1154              ((INFIX "*" (e.min) (s.mult)))
1155  ))                    )) :: e.min-cond,
1156  <Get-Var Max t.var> : {
1157    /*empty*/;
1158    e.max =
1159      ((INFIX ">" (t.m-var)
1160            ((INFIX "+" (t.s-var)
1161                  ((INFIX "*" (e.max) (s.mult)))
1162      ))                        ));
1163  } :: e.max-cond,
1164  (INFIX "%" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult)) :: e.div-cond,
1165  <Create-Int-Var ("len_") t.var
1166    (INFIX "/" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult))
1167  > :: t.len-var e.len-assign,
1168  <Set-Var (Length t.len-var) t.var>,
1169  <Unbind &Compute-Length t.idx>,
1170  <Put &Checked-Lengths t.idx>,
1171  <Get-Var Clashes t.var> :: e.clashes,
1172  <Map &Reclassify-Clash (<Sub (e.clashes) <? &Checked-Lengths>>)> : e,
1173  e.m-assign e.s-assign
1174  (IF ((INFIX "||" e.min-cond e.max-cond)) e.end-cycle)
1175  (IF (e.div-cond) e.fail)
1176  e.len-assign;
1177
1178$func  Get-Min e = e;
1179
1180$func? Get-Max e = e;
1181
1182CC-Unknown-Lengths (e.fail) e.idxs, {
1183  e.idxs : (t.idx) e.rest =
1184    <Lookup &Unknown-Lengths t.idx> : (e.len-Re) (e.len-Pe) (e.vars-Re) (e.vars-Pe),
1185    {
1186      <Get-Max e.vars-Re> :: e.max =
1187        <Get-Min e.vars-Pe> :: e.min,
1188        ((INFIX "<" (e.len-Re e.max) (e.len-Pe e.min)));
1189      /*empty*/;
1190    } :: e.cond1,
1191    {
1192      <Get-Max e.vars-Pe> :: e.max =
1193        <Get-Min e.vars-Re> :: e.min,
1194        ((INFIX ">" (e.len-Re e.min) (e.len-Pe e.max)));
1195      /*empty*/;
1196    } :: e.cond2,
1197    {
1198      e.cond1 : /*empty*/, e.cond2 : /*empty*/ = /*empty*/;
1199      (IF ((INFIX "||" e.cond1 e.cond2)) e.fail);
1200    } :: e.cond,
1201    e.cond
1202    <CC-Unknown-Lengths (e.fail) e.rest>;
1203  <RFP-Clear-Table &Unknown-Lengths>;
1204};
1205
1206Get-Min
1207{
1208  t.var e.vars = <Get-Var Min t.var> <Get-Min e.vars>;
1209  /*empty*/ = /*empty*/;
1210};
1211
1212Get-Max
1213{
1214  t.var e.vars = <Get-Var Max t.var> : v.max, v.max <Get-Max e.vars>;
1215  /*empty*/ = /*empty*/;
1216};
1217
1218$func Pos (e.Re) s.dir e.pos = e.pos;
1219
1220Pos {
1221  (e.Re) RIGHT e.pos = (INFIX "-" ((LENGTH e.Re)) (1) (e.pos));
1222  (e.Re) LEFT  e.pos = e.pos;
1223};
1224
1225/*
1226 * Информацию о проверках и заведении переменных, необходимых для создания
1227 * клешей из содержимого скобок, кодируем на ASAIL.
1228 */
1229CC-Deref (e.fail) e.actions, e.actions : {
1230  (SYMBOL? e.Re (s.dir e.pos)) e.rest =
1231    (IF ((SYMBOL? e.Re (<Pos (e.Re) s.dir e.pos>))) e.fail)
1232    <CC-Deref (e.fail) e.rest>;
1233  (DEREF t.var e.Re (s.dir e.pos)) e.rest =
1234    (DEREF t.var e.Re (<Pos (e.Re) s.dir e.pos>))
1235    <CC-Deref (e.fail) e.rest>;
1236  /*empty*/ = /*empty*/;
1237};
1238
1239CC-Eqs (e.fail) (e.assigns) e.eqs, {
1240  e.eqs : ((e.Re) (s.dir e.pos) t.Pt (e.len)) e.rest =
1241    {
1242      e.Re : t,
1243        <Get-Known-Length e.Re> : e.len (), // FIXME: здесь надо использовать
1244                          //        калькулятор
1245        s.dir e.pos : \{
1246          LEFT 0;
1247          RIGHT e.len;
1248        } =
1249        e.Re;;
1250    } :: e.Re-term,
1251    {
1252      e.len : 1 = TERM-EQ;      // FIXME: здесь надо использовать
1253                  //        калькулятор
1254      EQ;
1255    } :: s.eq,
1256    <Pos (e.Re) s.dir e.pos> :: e.pos,
1257    {
1258      \{
1259        <Get-Var Instantiated? t.Pt> : True = t.Pt (e.Re);
1260        t.Pt : \{
1261          (REF e);
1262          (STATIC e);
1263        }, {
1264          <Var? e.Re-term> = e.Re-term (t.Pt);
1265          t.Pt (e.Re);
1266        };
1267      } :: el (er),
1268        (IF ((NOT (s.eq el (er) (e.pos)))) e.fail) :: t.cond,
1269        {
1270          /*
1271           * Мы предполагаем, что во всех пришедших e.eqs все e.Re
1272           * уже были определены ранее.
1273           */
1274          e.assigns : $r e1 (s.op t.Pt e.def) e2 =
1275            <CC-Eqs (e.fail) (e1 (s.op t.Pt e.def) t.cond e2) e.rest>;
1276          t.cond <CC-Eqs (e.fail) (e.assigns) e.rest>;
1277        };
1278      <Set-Var (Instantiated? True) t.Pt>,
1279        {
1280          t.Pt : (SVAR e) =
1281            (IF
1282              ((NOT (SYMBOL? e.Re (<Pos (e.Re) s.dir e.pos>))))
1283              e.fail
1284            );;
1285        } :: e.cond,
1286        {
1287          <Get-Var Decl t.Pt> : s =
1288            e.cond <CC-Eqs (e.fail) (e.assigns
1289              (ASSIGN t.Pt (SUBEXPR e.Re (e.pos) (e.len))))
1290              e.rest>;
1291          <Vars-Decl t.Pt> : e,
1292            e.cond <CC-Eqs (e.fail) (e.assigns
1293              (SUBEXPR t.Pt e.Re (e.pos) (e.len))) e.rest>;
1294        };
1295    };
1296  e.assigns e.eqs;
1297};
1298
1299
1300
1301
1302Gener-Label e.QualifiedName =
1303  {
1304    <Lookup &Labels e.QualifiedName> : s.num,
1305      <"+" s.num 1>;
1306    1;
1307  } :: s.num,
1308  <Bind &Labels (e.QualifiedName) (s.num)>,
1309  (e.QualifiedName s.num);
1310
1311Add-To-Label (e.label) e.name = <Gener-Label e.label "_" e.name>;
1312
1313
1314
1315
1316Lookup-Func t.Fname, \{
1317  <Lookup &Fun t.Fname>;
1318  <Lookup &Fun? t.Fname>;
1319} : s.linkage s.tag t.pragma (e.Fin) (e.Fout) =
1320  s.linkage s.tag t.pragma (e.Fin) (e.Fout);
1321
Note: See TracBrowser for help on using the repository browser.