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

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