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

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