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

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