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

Last change on this file since 750 was 750, checked in by orlov, 18 years ago
  • Work towards clashes compilation.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 89.3 KB
Line 
1// $Source$
2// $Revision: 750 $
3// $Date: 2003-05-22 09:41:13 +0000 (Thu, 22 May 2003) $
4
5$use "rfpc";
6$use "rfp_err";
7$use "rfp_list";
8$use "rfp_helper";
9$use "rfp_check";
10$use "rfp_as2as";
11$use "rfp_format";
12$use "rfp_vars";
13$use "rfp_const";
14
15$use StdIO;
16$use Table;
17$use Box;
18$use Arithm;
19$use Access;
20$use Compare;
21$use Convert;
22$use Class;
23$use Apply;
24$use Dos;
25
26/*
27 * Tables for storing $const'ant values and their lengthes.
28 */
29$table Const-Len;
30
31/*
32 * Table for storing object names.
33 */
34$table Objects;
35
36/*
37 * Table for storing referenced functions.
38 */
39$table Ref-To-Funcs;
40
41/*
42 * Box for storing function out format
43 */
44$box Out-Format;
45
46/*
47 * Box for storing names for function result variables
48 */
49$box Res-Vars;
50
51/*
52 * Following table is used by Gener-Label function for obtaining unical (for
53 * certain function) label name.
54 * e.Key ::= e.QualifiedName      (parameter given to Gener-Label)
55 * e.Val ::= [Int]          (last index used with such e.QualifiedName)
56 */
57$table Labels;
58
59//$box Var-Stack;
60$table Vars-Tab;
61
62$box Last-Re;
63
64$box Greater-Ineqs;
65$box Less-Ineqs;
66
67$table Static-Exprs;
68
69$func Compile (e.targets) (e.headers) e.Items = e.Compiled-Items (INTERFACE e.headers);
70
71$func Print-Pragma s.channel t.Pragma = ;
72
73$func AS-To-Ref e.AS-Expr = e.Refal-Expr;
74
75$func Length-of e.Re = e.length;
76
77$func? Flat-Const? e.const = ;
78
79$func? Hard-Exp? e.expr = ;
80
81$func Comp-Func-Stubs = e.asail-funcs;
82
83$func Comp-Func s.tag t.name e.params-and-body = e.compiled-func;
84
85$func Set-Drops (e.declared-exprs) e.comp-func = (e.declared-exprs) e.result-func;
86
87$func Comp-Sentence e.Sentence = e.asail-sentence;
88
89$func Save-Snt-State = ;
90
91$func Recall-Snt-State = ;
92
93$func Pop-Snt-State = ;
94
95$func Extract-Calls e.Re = (e.last-Re) e.calls;
96
97$func Comp-Static-Exprs e.Reult-exprs = e.Result-exprs;
98
99$func Get-Clash-Sequence (e.last-Re) e.Snt = (e.clashes) e.rest-of-the-Sentence;
100
101$func Comp-Pattern t.Pattern e.Snt = e.asail-Snt;
102
103$func? Without-Calls? e.Re = ;
104
105//$func Old-Vars e.expr = e.expr;
106
107//$func Find-Known-Lengths e.clashes = (e.known-len-clashes) e.clashes;
108
109//$func? Known-Vars? e.vars = ;
110
111$func Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence = e.asail-sentence;
112
113$func? Find-Var-Length e.clashes = e.cond (e.clashes);
114
115$func Update-Ties t.var e.clashes = e.clashes;
116
117$func Known-Length-of e.expr = e.known-length (e.unknown-vars);
118
119$func? Cyclic-Restrictions e.clashes = e.cond (e.clashes);
120
121$func Cyclic-Min t.var = e.min;
122
123$func? Cyclic-Max t.var = e.max;
124
125$func? Check-Symbols e.clashes = e.cond (e.clashes) s.new?;
126
127$func? Check-Ft t.Ft (e.pos) (e.right-pos) t.name s.dir = e.Ft-cond s.stop?;
128
129$func? Dereference-Subexpr e.clashes = e.cond (e.clashes);
130
131$func Compare-Subexpr e.clashes = e.cond (e.asserts) (e.clashes) s.new?;
132
133$func Compare-Ft t.Ft = e.Ft-cond s;
134
135$func? Get-Source e.clashes = e.cond (e.clashes);
136
137$func Compose-Expr e.expr = e.compose (e.not-instantiated-vars) s.flat?;
138
139$func? Comp-Cyclic e.clashes = e.cond (e.clashes) (e.fail);
140
141$func Get-Subexprs e.vars = e.asail-decls;
142
143$func Unknown-Vars e.expr = e.known-expr (e.unknown-vars);
144
145$func Split-Hard-Left e.expr = e.hard;
146
147$func Split-Hard-Right e.expr = e.hard;
148
149$func Gener-Label e.QualifiedName = t.label;
150
151$func Add-To-Label t.label e.name = t.label;
152
153$func Comp-Calls e.Re = e.calls;
154
155$func Comp-Assigns e.assignments = e.asail-assignments;
156
157$func Comp-Format (e.last-Re) e.He = e.assignments;
158
159$func Get-Static-Exprs e.expr = e.expr (e.decls);
160
161$func Get-Static-Var e.expr = e.var (e.decl);
162
163
164
165************ Get AS-Items and targets, and pass it to Compile ************
166
167/*
168 * Ящик для объявлений статических функций, констант и объектов.  Все они
169 * выписываются в самом начале тела модуля.
170 */
171$box Declarations;
172
173RFP-Compile e.Items =
174  { <Lookup &RFP-Options ITEMS>;; } :: e.targets,
175  <Store &Declarations /*empty*/>,
176  <Init-Consts>,
177  <Compile (e.targets) () e.Items> :: e.Items t.Interface,
178  t.Interface (MODULE <? &Declarations> <Comp-Consts> e.Items);
179
180
181
182****************** Choose needed items and compile them ******************
183
184Compile (e.targets) (e.headers) e.Items, {
185  e.Items : e t.item e.rest,
186    {
187      e.targets : v =
188        e.targets : e t.name e,
189        t.item : (t t t t.name e);;
190    },
191    t.item : {
192      (IMPORT e) = () /*empty*/;
193      (s.link s.tag t.pragma t.name (e.in) (e.out) e.body), FUNC FUNC? : e s.tag e =
194        {
195          s.link : EXPORT = (DECL-FUNC EXPORT t.name);
196          <Put &Declarations (DECL-FUNC LOCAL t.name)> = /*empty*/;
197        } :: e.decl,
198        {
199          e.body : (BRANCH t.p e.branch) =
200            <Comp-Func s.tag t.name <Del-Pragmas (e.in) (e.out) e.branch>>;;
201        } :: e.comp-func,
202        (e.decl) e.comp-func;
203      (s.link CONST t.pragma t.name e.expr) =
204        (CONSTEXPR s.link t.name (e.expr) e.expr) :: t.const,
205        {
206          s.link : EXPORT = (t.const) /*empty*/;
207          <Put &Declarations t.const> = () /*empty*/;
208        };
209      (EXPORT s.tag t.pragma t.name) = ((DECL-OBJ EXPORT s.tag t.name)) /*empty*/;
210      (LOCAL  s.tag t.pragma t.name) =
211        <Put &Declarations (DECL-OBJ LOCAL s.tag t.name)>,
212        () /*empty*/;
213    } :: (e.decl) e.item =
214    e.item <Compile (e.targets) (e.headers e.decl) e.rest>;
215  /*<Comp-Func-Stubs>*/ (INTERFACE e.headers);
216};
217
218/*
219 * For each referenced function generate a stub one with format e = e.
220 */
221Comp-Func-Stubs =
222  <Domain &Ref-To-Funcs> () $iter {
223    e.funcs : ((e.QualifiedName)) e.rest,
224      (e.QualifiedName 0) :: t.Fname,
225//      <Bind &Ref-To-Funcs ((e.QualifiedName)) (t.Fname)>,
226//      {
227//        <In-Table? &Fun? (e.QualifiedName)> =
228//          <Bind &Back-Funcs (t.Fname) ()>;;
229//      },
230//      <Bind &Fin (t.Fname) ((EVAR))>,
231//      <Bind &Fout (t.Fname) ((EVAR))>,
232      <Lookup-Func (e.QualifiedName)> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
233      <Gener-Vars (e.Fin) "stub"> :: e.He,
234      <Comp-Func s.tag t.Fname ((EVAR ("arg" 1))) ((EVAR ("res" 1)))
235        (LEFT e.He) (RESULT (CALL (e.QualifiedName) e.He))
236      > :: e.asail,
237      e.rest (e.asail-funcs e.asail);
238  } :: e.funcs (e.asail-funcs),
239  e.funcs : /*empty*/ =
240  // Here is place to define expressions - references to stub functions.
241  // Use &Ref-To-Funcs for that.
242  e.asail-funcs;
243
244Comp-Func s.tag t.name (e.in) (e.out) e.Sentence =
245  <RFP-Clear-Table &Labels>,
246  <RFP-Clear-Table &Static-Exprs>,
247  <Store &Greater-Ineqs /*empty*/>,
248  <Store &Less-Ineqs /*empty*/>,
249//!     <RFP-Clear-Table &Vars-Tab>,
250  <Init-Vars>,
251//!     <Ref-To-Var e.Sentence> :: e.Sentence,
252//!     <Store-Vars <Vars e.out>> :: e.res-vars,
253  <Vars <Gener-Vars (e.out) "res">> :: e.res-vars,
254  <Vars-Decl e.res-vars> : e,
255  <Store &Res-Vars e.res-vars>,
256  <Store &Out-Format <Format-Exp e.out>>,
257//!     <Norm-Vars (<Vars e.in>) e.Sentence> :: (e.arg-vars) e.Sentence,
258//!     <Declare-Vars Expr e.arg-vars> : e,
259  <Vars e.in> :: e.arg-vars,
260  <Map &Ref-Set-Var (Instantiated? True) (e.arg-vars)> : e,
261*       <Vars-Decl e.arg-vars> : e,
262*       <Instantiate-Vars e.arg-vars>,
263  <Store &Last-Re /*empty*/>,
264  s.tag : {
265    FUNC = FATAL;
266    FUNC? = RETFAIL;
267  } :: t.retfail,
268  (FUNC t.name (<Vars-Print e.arg-vars>) (<Vars-Print e.res-vars>)
269    <Comp-Sentence Tail ((t.retfail)) () e.Sentence>
270  ) :: e.comp-func,
271*       <Set-Drops () <Gener-Var-Names e.comp-func>> :: t e.comp-func,
272  <Gener-Var-Names e.comp-func> :: e.comp-func,
273//!     <Post-Comp (e.res-vars) e.comp-func> :: t e.result,
274//!     e.result;
275  e.comp-func;
276//  :: (e.func-decl) e.func-body,
277//  () <Domain &Declarations> $iter {
278//    e.vars : (t.var) e.rest-vars,
279//      (e.var-decls (DECL t.var)) e.rest-vars;
280//  } :: (e.var-decls) e.vars,
281//  e.vars : /*empty*/,
282//  (e.func-decl e.var-decls e.func-body);
283
284Ref-To-Var e.Snt =
285  () e.Snt $iter {
286    e.Snt : t.Statement e.rest, t.Statement : {
287      (REF t.name) = (e.new-Snt /*<New-Vars (VAR REF t.name)>*/) e.rest;
288
289//!                     <Table> :: s.tab,
290//!                     <Bind &Vars-Tab (t.name) (s.tab)>,
291//!                     <Set-Var t.name (Format) (<Format-Exp (REF t.name)>)>,
292//!                     <Set-Var t.name (Declared) (True)>,
293//!                     <Set-Var t.name (Instantiated) (True)>,
294//!                     <Set-Var t.name (Left-compare) ()>,
295//!                     <Set-Var t.name (Right-compare) ()>,
296//!                     <Set-Var t.name (Left-checks) ()>,
297//!                     <Set-Var t.name (Right-checks) ()>,
298//!                     (e.new-Snt (VAR t.name)) e.rest;
299
300      (e.expr) = (e.new-Snt (<Ref-To-Var e.expr>)) e.rest;
301      t = (e.new-Snt t.Statement) e.rest;
302    };
303  } :: (e.new-Snt) e.Snt,
304  e.Snt : /*empty*/ =
305  e.new-Snt;
306
307Set-Drops (e.declared) e.comp-func =
308  e.comp-func () (e.declared) $iter {
309    e.comp-func : t.first e.rest, {
310      t.first : \{
311        (EXPR t.var e) = (DROP t.var) (t.first) t.var Init;
312        (DEREF t.var e) = (DROP t.var) (t.first) t.var Init;
313        (SUBEXPR t.var e) = (DROP t.var) (t.first) t.var Init;
314        (DECL Expr t.var) = (DROP t.var) () t.var Decl;
315        (DECL "int" t.var) = /*empty*/ () t.var Decl;
316      } :: e.drop (e.constr) t.var s.init,
317        {
318          e.declared : e1 t.var s.old-init e2, s.old-init : {
319            Init, {
320              t.var : (VAR ("const" e)) =
321                e.rest (e.result-func) (e.declared);
322              e.rest (e.result-func e.drop e.constr) (e.declared);
323            };
324            Decl, s.init : {
325              Decl =
326                e.rest (e.result-func) (e.declared);
327              Init =
328                t.first : (s.method t.var e.args),
329                e.rest (e.result-func (ASSIGN t.var (s.method e.args)))
330                (e1 e2 t.var s.init);
331                /*
332                 * FIXME: if s.method is EXPR, it shouldn't be written.
333                 */
334            };
335          };
336          e.rest (e.result-func t.first) (e.declared t.var s.init);
337        };
338      t.first : (LABEL (t.label) e.expr) =
339        <Set-Drops (e.declared) e.expr> :: (e.declared) e.expr,
340        e.rest (e.result-func (LABEL (t.label) e.expr)) (e.declared);
341      t.first : (e.expr) =
342        <Set-Drops (e.declared) e.expr> :: t e.expr,
343        e.rest (e.result-func (e.expr)) (e.declared);
344      t.first : s.symbol =
345        e.rest (e.result-func s.symbol) (e.declared);
346    };
347  } :: e.comp-func (e.result-func) (e.declared),
348  e.comp-func : /*empty*/ =
349  (e.declared) e.result-func;
350
351
352Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Sentence, e.Sentence : {
353
354  /*empty*/ = /*empty*/;
355
356  /*
357   * In case of Re look if we should do a tailcall.  If not, then compile
358   * function calls from the Re and assign results to the out parameters or
359   * use them in compilation of the rest of the sentence.
360   */
361  (RESULT e.Re) e.Snt =
362    {
363      /*
364       * If the Re is the last action in the sentence then we can do
365       * tailcall if one of the following is true:
366       *  - Re is a call of non-failable function;
367       *  - Re is a call of a failable function, current function is
368       *  failable, and the failures stack is empty.
369       * In both cases out format of the called function should coincide
370       * with those of compiled one.
371       * FIXME: really we can do tailcall if all the parameters of
372       * compiled function that won't get their values from the call can
373       * be assigned from other sources.  Some support from runtime is
374       * needed though.
375       */
376      e.Snt : /*empty*/, s.tail? : Tail, e.Re : (CALL t.name e.arg),
377        { <In-Table? &Fun? t.name> = v.fails : (RETFAIL);; },
378        <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
379        <Subformat? (e.Fout) (<? &Out-Format>)> =
380        <Extract-Calls e.arg> :: (e.last-Re) e.calls,
381        <Comp-Static-Exprs <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
382        <Comp-Calls <R 0 v.fails> e.calls>
383        (TAILCALL t.name (e.splited-Re) (<? &Res-Vars>));
384
385      <Extract-Calls e.Re> :: (e.last-Re) e.calls,
386        <Comp-Calls <R 0 v.fails> e.calls> :: e.comp-calls,
387        {
388          e.Snt : /*empty*/, s.tail? : Tail =
389            <Split-Re (<? &Out-Format>) e.last-Re> :: e.splited-Re,
390            <Comp-Static-Exprs e.splited-Re> :: e.splited-Re,
391            e.comp-calls <Comp-Assigns <Zip (<? &Res-Vars>) (e.splited-Re)>>;
392
393          e.comp-calls <Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Snt>;
394        };
395    };
396
397  /*
398   * In case of He compile assignments from last Re and then (with new state
399   * of variables) proceed with the rest of the sentence.
400   */
401  (FORMAT e.He) e.Snt =
402    <Comp-Format (e.last-Re) e.He>
403    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
404
405  /*
406   * In case of Pe get from the begining of the sentence a maximum possible
407   * sequence of clashes and compile it.  New values of variables from the
408   * clashes use in the compilation of the rest of the sentence.
409   */
410  (s.dir e.Pattern) e.Snt, s.dir : \{ LEFT; RIGHT; } =
411    <Get-Clash-Sequence (e.last-Re) e.Sentence> :: (e.clashes) e.Sentence,
412//    <WriteLN !!! e.clashes>,
413    <Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence>;
414
415  (s.block) e, BLOCK BLOCK? : e s.block e = <WriteLN! &StdErr "Empty block?">, $fail;
416
417  /*
418   * In case of a block first see if its results are needed for something
419   * after the block and determine whether the block is a source.  Then
420   * compile each branch in turn.
421   */
422  (s.block e.branches) e.Snt,
423    s.block : \{
424      BLOCK = (FATAL);
425      BLOCK?;
426    } :: e.fatal? =
427    /*
428     * If the block initializes an $iter then extract from the $iter the He
429     * for placing it in the end of each branch.
430     * Then look if the block is used by a pattern or format expression.
431     * If so, we should declare variables from that expression before
432     * entering any branch -- those should be visible after the block.
433     * If next after the block is (Comp Error) then block results should be
434     * used as values for $error, so place (Comp Error) in the end of each
435     * branch.
436     */
437    {
438      e.Snt : (ITER t.body t.format t.cond) e.rest =
439        t.format (Comp Iter t.body t.format t.cond) e.rest;
440      e.Snt;
441    } :: e.Snt,
442    e.Snt : {
443      t.first e.rest, t.first : \{
444        (LEFT e.pattern) = e.pattern;
445        (RIGHT e.pattern) = e.pattern;
446        (FORMAT e.format) = e.format;
447      } :: e.expr =
448        <Vars e.expr> :: e.vars,
449*                               <New-Vars e.vars>,
450        (<Vars-Decl e.vars>) (t.first) ((Comp Source)) e.rest;
451      (Comp Error) e.rest =
452        () ((Comp Error)) () /*empty*/;
453      e = () () () e.Snt;
454    } :: (e.decls) (e.next-term) (e.source?) e.Snt,
455    /*
456     * The block is a source if after it goes pattern or format expression
457     * (in that case e.source? isn't empty) or e.Snt isn't empty.
458     * Branches in the block are tail sentences if the current sentence is
459     * tail and the block isn't a source.
460     */
461    {
462      \{ e.source? : v; e.Snt : v; } = ((Comp Source)) Notail;
463      s.tail? : Tail = () Tail;
464      () Notail;
465    } :: (e.source?) s.tail-branch?,
466    /*
467     * In case our block is a source we should mark the position in the
468     * failures stack, so that we can jump to it after CUTALL.  And if our
469     * block isn't failable we should add (FATAL) to the end of the stack.
470     */
471    v.fails e.source? e.fatal? :: v.branch-fails,
472    /*
473     * We put all compiled branches in a block, so positive return from a
474     * branch is a break from that block.
475     * Each branch in its turn is placed in its own block, so for a $fail
476     * to the next branch we should just break from that inner block.
477     * Each branch is compiled with the current sentence state and the
478     * state is recalled after that.  When all branches are compiled the
479     * state is popped out from the stack.
480     * If last branch fails then the whole block fails, and return from the
481     * last branch is return from the block.  So the last branch isn't
482     * placed in a block and is processed with the failures stack that was
483     * before entering the block.  Note: this trick helps us find more
484     * tailcalls.  If the call of a failable function is on the last branch
485     * of the block and the failures stack is empty we can do tailcall.
486     * When the last branch is compiled with the block's stack, all we
487     * should do is to check it.
488     */
489    <Gener-Label "block"> :: t.label,
490    <Save-Snt-State>,
491    (e.branches) /*e.comp-branches*/ $iter {
492      e.branches : (BRANCH e.branch) e.rest-br =
493        <Add-To-Label t.label "branch"> :: t.br-label,
494        <Comp-Sentence
495          s.tail-branch?
496          (v.branch-fails ((BREAK t.br-label)))
497          (e.last-Re)
498          e.branch e.next-term
499        > :: e.comp-br,
500        <Recall-Snt-State>,
501        (e.rest-br) e.comp-branches (LABEL (t.br-label) e.comp-br (BREAK t.label));
502    } :: (e.branches) e.comp-branches,
503    e.branches : (BRANCH e.branch) =
504    <Comp-Sentence
505      s.tail-branch? (v.branch-fails) (e.last-Re) e.branch e.next-term
506    > :: e.last-branch,
507    <Pop-Snt-State>,
508    e.decls (LABEL (t.label) e.comp-branches e.last-branch)
509    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
510
511  /*
512   * In case of $iter first of all compile initial assignment to the hard
513   * expression.
514   */
515  (ITER t.body t.format t.cond) e.Snt =
516    <Comp-Sentence s.tail? (v.fails) (e.last-Re)
517      t.format (Comp Iter t.body t.format t.cond) e.Snt
518    >;
519
520  /*
521   * Then compile $iter condition and body both with the current state of the
522   * sentence.
523   * e.Snt can contain only (Comp Error), so compile it together with the
524   * condition.
525   * If condition fails we should compute the body, so put the compiled
526   * condition in a block and place a break from it to the failures stack.
527   */
528  (Comp Iter (BRANCH e.body) t.format (BRANCH e.condition)) e.Snt =
529    <Gener-Label "iter"> :: t.label,
530    <Save-Snt-State>,
531    <Comp-Sentence s.tail? (v.fails ((BREAK t.label))) () e.condition e.Snt>
532      :: e.comp-condition,
533    <Pop-Snt-State>,
534    <Comp-Sentence Notail (v.fails) () e.body t.format> :: e.comp-body,
535    (FOR () () () (LABEL (t.label) e.comp-condition) e.comp-body);
536
537  /*
538   * In case of $trap/$with at first compile try-sentence.  All $fails from
539   * it should become errors.
540   * Then recall the state of the sentence and compile catching of an error
541   * with a variable err.
542   * e.Snt can be only (Comp Error), so compile it together with both
543   * sentences -- when either of it comuptes to an object expression it
544   * becomes a value of the $error.
545   */
546  (TRY (BRANCH e.try) e.catch) e.Snt =
547    <Save-Snt-State>,
548    <Comp-Sentence Notail ((FATAL)) () e.try e.Snt> :: e.comp-try,
549    <Pop-Snt-State>,
550    <Comp-Sentence s.tail? (v.fails) () (RESULT (EVAR ("err" 0))) e.catch e.Snt>
551      :: e.comp-catch,
552    (TRY e.comp-try) (CATCH-ERROR e.comp-catch);
553
554  /*
555   * In case of \? add Stake to the failures stack.  Add last fail after it
556   * for <R 0 v.fails> continue to work.
557   */
558  (STAKE) e.Snt =
559    <Comp-Sentence s.tail? (v.fails (Comp Stake) <R 0 v.fails>) () e.Snt>;
560
561  /*
562   * In case of \! forget all failure catchers after last \?.
563   * If there is no Stake then we are inside negation or error (we assume the
564   * program is correct).  So the right failure catcher is in the bottom of
565   * the stack.
566   */
567  (CUT) e.Snt =
568    {
569      v.fails : $r v.earlier-fails (Comp Stake) e = v.earlier-fails;
570      <L 0 v.fails>;
571    } :: v.fails,
572    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
573
574  /*
575   * In case of = clear the failures stack up to the closest source.
576   */
577  (CUTALL) e.Snt =
578    {
579      v.fails : $r v.earlier-fails (Comp Source) e = v.earlier-fails;
580      <L 0 v.fails>;
581    } :: v.fails,
582    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
583
584  /*
585   * In case of = in the Refal-6 sense (non-transparent hedge for the fails),
586   * $fail(k) should become $error(Fname "Unexpected fail"), so clear the
587   * failures stack and put that value in it.
588   */
589  NOFAIL e.Snt =
590    <Comp-Sentence s.tail? ((FATAL)) (e.last-Re) e.Snt>;
591
592  /*
593   * In case of $fail return last failure catcher.
594   */
595  (FAIL) e.Snt =
596    v.fails : e (e.last-fail),
597    e.last-fail;
598
599  /*
600   * In case of # we should proceed with the rest if the source is computed
601   * to $fail.
602   * We could compile the rest of the sentence and place it in the
603   * failures stack.  But then the compiled sentence would be copied as many
604   * times as there are $fail's to the upper level in the source.  So we
605   * place compiled source in the block and put the break to exit from it in
606   * the stack.
607   * When compiling the source mark it as Notail as usual.
608   * If the source isn't computed to $fail we should proceed with the last
609   * failure catcher.
610   */
611  (NOT (BRANCH e.branch)) e.Snt =
612    <Gener-Label "negation"> :: t.label,
613    v.fails : e (e.last-fail),
614//    <Save-Snt-State>,
615    <Comp-Sentence Notail (((BREAK t.label))) () e.branch> e.last-fail
616      :: e.comp-negation,
617//    <Pop-Snt-State>,
618    (LABEL (t.label) e.comp-negation) <Comp-Sentence s.tail? (v.fails) () e.Snt>;
619
620//  (Comp Verbatim expr) = expr;
621
622  /*
623   * In case of $error all fails become $error(Fname "Unexpected fail").  So
624   * place that value in the failures stack and then compile the computation
625   * of the rest of the sentence and the last Re which should be the value of
626   * $error.
627   */
628  (ERROR) e.Snt =
629    <Comp-Sentence Notail ((FATAL)) e.Snt () (Comp Error)>;
630
631  (Comp Error) e.Snt = (ERROR e.last-Re);
632
633//  (Comp Fatal) = FATAL;
634
635//  (Comp Retfail) = RETFAIL;
636
637  (Comp Fail t.fail) e.Snt = <Comp-Sentence s.tail? (v.fails t.fail) () e.Snt>;
638
639};
640
641
642
643********** Sentence state stack and functions for work with it. **********
644
645$box Snt-State;
646
647/*
648 * Put current state in the stack.
649 */
650Save-Snt-State = <Put &Snt-State <Vars-Copy-State>>;
651
652/*
653 * Set current state to that at the top of the stack.
654 */
655Recall-Snt-State = <Vars-Set-State <R 0 <? &Snt-State>>>;
656
657/*
658 * Pop the top from the stack and set current state to it.
659 */
660Pop-Snt-State =
661  <Recall-Snt-State>,
662  <Store &Snt-State <Middle 0 1 <? &Snt-State>>>;
663
664
665
666********************** Function calls compilation. ***********************
667
668/*
669 * $func Extract-Calls e.Re = (e.last-Re) e.calls;
670 *
671 *
672 *
673 */
674Extract-Calls {
675  (CALL t.name e.arg) e.rest =
676    <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
677    <Extract-Calls e.arg> :: (e.last-Re) e.calls,
678    <Comp-Static-Exprs <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
679    <RFP-Extract-Qualifiers t.name> :: t e.prefix,
680*               <Del-Pragmas <Gener-Vars 0 (e.Fout) e.prefix>> : e.Re s,
681//!             <Store-Vars <Vars e.res-Re>> :: e.ress,
682//!             <Instantiate-Vars e.ress>,
683//!             <Ref-To-Var <Strip-STVE e.res-Re>> :: e.res-Re,
684//!             e.decls <Declare-Vars "Expr" e.ress> :: e.decls,
685    <Gener-Vars (e.Fout) e.prefix> :: /*(e.vars)*/ e.Re,
686    <Vars e.Re> :: e.vars,
687    <Map &Ref-Set-Var (Instantiated? True) (e.vars)> : e,
688    {
689      s.tag : FUNC? =   (Failable (CALL t.name (e.splited-Re) (e.vars)));
690      (CALL t.name (e.splited-Re) (e.vars));
691    } :: t.call,
692    <Extract-Calls e.rest> :: (e.rest-Re) e.rest-calls,
693    (e.Re e.rest-Re) e.calls <Vars-Decl e.vars> t.call e.rest-calls;
694  (PAREN e.Re) e.rest =
695    <Extract-Calls e.Re> :: (e.last-Re) e.calls,
696    <Extract-Calls e.rest> :: (e.rest-Re) e.rest-calls,
697    ((PAREN e.last-Re) e.rest-Re) e.calls e.rest-calls;
698  t.Rt e.Re =
699    <Extract-Calls e.Re> :: (e.last-Re) e.calls,
700    (t.Rt e.last-Re) e.calls;
701  /*empty*/ = () /*empty*/;
702};
703
704
705Comp-Calls (e.fail) e.calls, e.calls : {
706  (Failable t.call) e.rest =
707    (IF ((NOT t.call)) e.fail) <Comp-Calls (e.fail) e.rest>;
708  t.call e.rest =
709    t.call <Comp-Calls (e.fail) e.rest>;
710  /*empty*/ = /*empty*/;
711};
712
713
714
715*********** Compilation of static parts of result expressions ************
716
717$func Static-Expr? s.create? e.Re = static? e.Re;
718
719$func Static-Term? t.Rt = static? t.Rt;
720
721
722/*
723 * Extract static parts from each Re.
724 */
725Comp-Static-Exprs {
726  (e.Re) e.rest = <Static-Expr? Create e.Re> :: s e.Re, (e.Re) <Comp-Static-Exprs e.rest>;
727  /*empty*/     = /*empty*/;
728};
729
730
731/*
732 * Find all the longest static parts in the upper level of Re.  Create STATIC
733 * form in place of each one.
734 * Return a tag pointing whether the whole expression is static and expression
735 * with static parts replaced by STATIC forms.  Dynamic parts are returned
736 * unchanged.
737 */
738Static-Expr? {
739  s.create? t.Rt e.Re =
740    <Static-Term? t.Rt> : {
741      Static t.Rt =
742        {
743          e.Re : e1 t2 e3, <Static-Term? t2> : Dynamic t.dyn-Rt =
744            <Static-Expr? Create e3> :: s e3,
745            Dynamic <Create-Static t.Rt e1> t.dyn-Rt e3;
746          {
747            s.create? : Create = Static <Create-Static t.Rt e.Re>;
748            Static t.Rt e.Re;
749          };
750        };
751      Dynamic t.dyn-Rt =
752        <Static-Expr? Create e.Re> :: s e.Re,
753        Dynamic t.dyn-Rt e.Re;
754    };
755  s.create? /*empty*/ = Static;
756};
757
758
759/*
760 * The same as Static-Expr? but for terms.
761 */
762Static-Term? {
763  symbol       = Static symbol;
764  (PAREN e.Re) = <Static-Expr? Not-Create e.Re> :: static? e.Re, static? (PAREN e.Re);
765  (REF t.name) = Static (REF t.name);
766  t.var        = Dynamic t.var;
767};
768
769
770
771***************** Compilation of assignment to variables *****************
772
773$func Comp-Assign-to-Var e = e;
774
775Comp-Assign-to-Var (t.var (e.Re)) =
776  <Set-Var (Instantiated? True) t.var>,
777  {
778    t.var : e.Re = /*empty*/;
779    <Generated-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
780    <Get-Var Decl t.var> : s = (ASSIGN <Vars-Print t.var> e.Re);
781    <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
782  };
783
784Comp-Assigns e.assigns = <Map &Comp-Assign-to-Var (e.assigns)>;
785
786
787
788************************** FORMAT compilation. ***************************
789
790$box Aux-Index;
791
792$func Gener-Aux-Var = t.new-aux-var;
793
794Gener-Aux-Var =
795  <? &Aux-Index> : s.n,
796  <Store &Aux-Index <"+" s.n 1>>,
797  (VAR ("aux" s.n));
798
799
800$func Create-Aux-Vars (e.vars) e.splited-Re = e.assigns;
801
802
803Comp-Format (e.last-Re) e.He =
804  <Vars e.He> :: e.vars,
805  <Comp-Static-Exprs <Split-Re (<Format-Exp e.He>) e.last-Re>> :: e.splited-Re,
806  <Store &Aux-Index 1>,
807  <Create-Aux-Vars (e.vars) e.splited-Re> :: e.assigns,
808  <Comp-Assigns e.assigns>;
809
810/*
811 * Итак, e.vars -- все переменные, входящие в форматное выражение.  Каждая
812 * переменная может входить в форматное выражение только один раз, поэтому
813 * повторяющихся среди них нет.
814 * e.splited-Re -- набор результатных выражений.  На каждую переменную из
815 * e.vars по выражению, которое должно быть ей присвоено.
816 *
817 * Если переменная t.var_i используется в выражении e.Re_j, и i /= j, то
818 * переменной t.var_j значение должно быть присвоено раньше, чем перeменной
819 * t.var_i.  Если же, по аналогичным соображениям, t.var_i должна получить
820 * значение раньше t.var_j, необходимо завести вспомогательную переменную.
821 *
822 * Пример:
823 *
824 * t1 (t1 t2) (t1 t3) :: t2 t1 t3
825 *
826 * t3 = (t1 + t3)();
827 * aux_1 = t1;
828 * t1 = (t1 + t2)()
829 * t2 = aux_1;
830 *
831 * В общем случае вспомогательная переменная требуется, если двум переменным
832 * необходимы старые значения друг друга (возможно, не напрямую, а через
833 * промежуточные переменные).
834 *
835 * Вместо того, чтобы искать и анализировать такие циклы, будем действовать по
836 * методу "наибольшей пользы".  А именно:
837 *
838 *   - Для каждой переменной выпишем все другие переменные, которым требуется
839 *     её старое значение, а также отдельно те, старые значения которых
840 *     требуются ей.
841 *
842 *   - Всем переменным, от старых значений которых ничего не зависит, можно
843 *     смело присвоить новые значения.  При этом они исчезают из списков
844 *     зависимостей оставшихся переменных.
845 *
846 *   - Все переменные, новые значения которых ни от чего не зависят, можно
847 *     отложить, чтобы присвоить им значения тогда, когда будет удобно.  Т.е.
848 *     тогда, когда списки зависящих от них переменных опустеют.
849 *
850 *   - Чтобы означить оставшиеся, нужны вспомогательные переменные.  Выберем
851 *     одну из переменных, с максимальным списком тех, от которых она зависит,
852 *     и положим её значение во вспомогательную переменную.  Так как мы сразу
853 *     уменьшили кол-во зависимостей у максимального кол-ва переменных,
854 *     локально мы добились наибольшей пользы, хотя не исключено, что глобально
855 *     такой метод и не даст наименьшего кол-ва вспомогательных переменных.
856 *     Кроме того, мы не пытаемся выбрать наилучшую переменную из нескольких с
857 *     максимальным списком зависимостей.
858 *
859 *   - Повторяем всё это до тех пор, пока у каждой переменной не опустеет
860 *     список зависящих от неё.
861 *
862 *
863 * Для нашего примера:
864 *
865 * t1 (t1 t2) (t1 t3) :: t2 t1 t3
866 *
867 * t1 -- (t2 t3) (t2)
868 * t2 -- (t1)    (t1)
869 * t3 -- ()      (t1)
870 *
871 *
872 * Для каждой переменной var_i найдём все j /= i, такие что в Re_j встречается
873 * var_i -- provide[i], и а также все j /= i, такие что var_j нужна для
874 * подсчёта var_i, т.е. встречается в Re_i.
875 *
876 * Res-vars <- <Map &Vars (Res)>
877 * for var_i in vars
878 *     provide[i] <-
879 *     for vars-Re_j in Res-vars, j /= i
880 *         vars-Re_j : e var_i e = j
881 *     require[i] <- <Res-vars[i] `*` vars[^i]> : e var_j e, j
882 *
883 * Res-vars = map Vars Res
884 * provide, require =
885 *   {   [ j | vars-Re_j <- Res-vars, j /= i, var_i `in` vars-Re_j ]
886 *     , [ j | var_j <- Res-vars[i] `*` vars, i /= j]
887 *     | var_i <- vars
888 *   }
889 *
890 */
891
892$func CAV e.vars (e.assigns) (e.delayed) = e.assigns;
893
894$func Get-Vars e = e;
895Get-Vars (e.Re) = (<Vars e.Re>);
896
897Create-Aux-Vars (e.vars) e.splited-Re =
898  <Zip (<Map &Get-Vars (e.splited-Re)>) (e.vars)> :: e.list,
899  <Box> :: s.box,
900  <Box> :: s.provide-i,
901  <Box> :: s.require-i,
902  {
903    e.vars : e1 t.var-i e2,
904      {
905        e.list : e ((e.vars-Re) t.var-j) e,
906          \{
907            t.var-i : t.var-j = <Put s.require-i <And (e1 e2) e.vars-Re>>;
908            e.vars-Re : e t.var-i e = <Put s.provide-i t.var-j>;
909          },
910          $fail;
911        <L <Length e1> e.splited-Re> :: t.Re-i,
912        <Put s.box (t.var-i t.Re-i (<? s.provide-i>) (<? s.require-i>))>,
913          <Store s.provide-i /*empty*/>,
914          <Store s.require-i /*empty*/>;
915      },
916      $fail;;
917  },
918  <CAV <? s.box> (/*assigns*/) (/*delayed*/)>;
919
920
921/*
922 * Если есть переменная, у которой список provide пуст, её можно посчитать.
923 * Это выражается в том, что она (вместе с присваиваемым значением) добавляется
924 * в список assigns, убирается из списка vars, а также из всех списков provide
925 * и delayed.  В списках require её не было.
926 *
927 * CAV Res vars provide require assigns delayed =
928 *   { i | var_i <- vars, provide_i == [] } ->     // Здесь неверно!  На переменные
929 *                                                    из delayed тоже надо смотреть.
930 *       vars    = vars - var_i
931 *       provide = [ provide_j - i | provide_j <- provide ]
932 *       assigns = assigns++[(var_i, Res[i])]
933 *       delayed = [ (var_j, provide_j - i) | (var_j, provide_j) <- delayed ]
934 *       CAV Res vars provide require assigns delayed
935 */
936
937$func Assign-Empty-Provides e.vars  = e.assigns (e.vars);
938
939Assign-Empty-Provides {
940  e1 (t.var-i t.Re-i (/*empty provide_i*/) (e.require-i)) e2 =
941    <Box> :: s.vars,
942    {
943      e1 e2 : e (t.var-j t.Re-j (e.provide-j) (e.require-j)) e,
944        <Put s.vars (t.var-j t.Re-j (<Sub (e.provide-j) t.var-i>) (e.require-j))>,
945        $fail;;
946    },
947    (t.var-i t.Re-i) <Assign-Empty-Provides <? s.vars>>;
948  e.vars = /*empty*/ (e.vars);
949};
950
951
952/*
953 * Если есть переменная, у которой список require пуст, кладём её в delayed.
954 * Она будет посчитана, когда у неё опустеет список provide, т.е. когда не
955 * останется переменных, у которых она в списке require.
956 */
957$func Delay-Empty-Requires e.vars  = e.delayed (e.vars);
958
959Delay-Empty-Requires {
960  e1 t.var e2, t.var : (t.var-i t.Re-i (e.provide-i) (/*empty require_i*/)) =
961    <Delay-Empty-Requires e2> :: e.delayed (e.vars),
962    t.var e.delayed (e1 e.vars);
963  e.vars = /*empty*/ (e.vars);
964};
965
966
967/*
968 * Выбор переменной (из двух) с более длинным списком требуемых ей значений.
969 */
970$func Max-Require e = e;
971
972Max-Require t.arg1 t.arg2 =
973  t.arg1 : (t.var1 t.Re1 t.provide1 (e.require1)),
974  t.arg2 : (t.var2 t.Re2 t.provide2 (e.require2)),
975  {
976    <"<" (<Length e.require1>) (<Length e.require2>)> = t.arg2;
977    t.arg1;
978  };
979
980
981/*
982 * Подставить вспомогательную переменную вместо исходной во всех результатных выражениях.
983 * Присваивание к исходной переменной убрать (оно к этому моменту уже выполнено).
984 * Убрать переменную из списков зависимостей.
985 */
986$func Subst-Aux-Var e = e;
987
988Subst-Aux-Var t.var t.aux (t.v t.Re (e.provide) (e.require)), {
989  t.var : t.v = /*empty*/;
990  (
991    t.v
992    <Subst (t.var) ((t.aux)) t.Re>
993    (<Sub (e.provide) t.var>)
994    (<Sub (e.require) t.var>)
995  );
996};
997
998
999/*
1000 * Извлечь присваивание из всей информации о переменной.
1001 */
1002$func Extract-Assigns e = e;
1003Extract-Assigns (t.var t.Re e) = (t.var t.Re);
1004
1005
1006/*
1007 * Основной цикл обработки присваиваний.
1008 *
1009 * 1) Из всех переменных (в том числе и отложенных), от которых больше ничего
1010 *    не зависит, сделать присваивания.
1011 * 2) Все переменные, которые больше ни от чего не зависят, отложить.
1012 * 3) Если осталось хотя бы две неотложенных переменных, выбирать из них ту,
1013 *    которая зависит от наибольшего числа переменных, подставить везде вместо
1014 *    неё вспомогательную, перейти к пункту 1.
1015 */
1016CAV e.vars (e.assigns) (e.delayed) =
1017  <Assign-Empty-Provides e.vars> :: e.new-assigns (e.vars),
1018  e.assigns e.new-assigns <Assign-Empty-Provides e.delayed> :: e.assigns (e.delayed),
1019  e.delayed <Delay-Empty-Requires e.vars> :: e.delayed (e.vars),
1020  {
1021    e.vars : t t e =
1022      <Foldr1 &Max-Require (e.vars)> : (t.var t.Re e),
1023      <Gener-Aux-Var> :: t.aux,
1024      e.assigns (t.aux (t.var)) (t.var t.Re) :: e.assigns,
1025      <Map &Subst-Aux-Var t.var t.aux (e.vars)> :: e.vars,
1026      <Map &Subst-Aux-Var t.var t.aux (e.delayed)> :: e.delayed,
1027      <CAV e.vars (e.assigns) (e.delayed)>;
1028    e.assigns <Map &Extract-Assigns (e.vars e.delayed)>;
1029  };
1030
1031
1032
1033
1034Get-Clash-Sequence (e.last-Re) t.Pattern e.Snt =
1035  ((e.last-Re) t.Pattern) e.Snt $iter {
1036    e.Snt : (RESULT e.Re) t.Pt e.rest =
1037      (e.clashes (e.Re) t.Pt) e.rest;
1038  } :: (e.clashes) e.Snt,
1039  # \{
1040    e.Snt : \{
1041      (RESULT e.Re) (LEFT e) e = e.Re;
1042      (RESULT e.Re) (RIGHT e) e = e.Re;
1043    } :: e.Re,
1044      <Without-Calls? e.Re>;
1045  } =
1046  (e.clashes) e.Snt;
1047
1048
1049Comp-Pattern (s.dir e.PatternExp) e.Sentence =
1050  <Norm-Vars (<Vars e.PatternExp>) (s.dir e.PatternExp) e.Sentence>
1051    : t t.Pattern e.Snt,
1052//  (Unwatched (<? &Last-Re>) t.Pattern) e.Snt $iter {
1053  /*
1054   * Uncomment previous line and delete next one to activate Split-Clashes
1055   * function
1056   */
1057  ((<? &Last-Re>) t.Pattern) e.Snt $iter {
1058    e.Snt : (RESULT e.Re) (s.d e.Pe) e =
1059//      <WriteLN Matching (RESULT e.Re) (s.d e.Pe)>,
1060      <Norm-Vars (<Vars e.Pe>) e.Snt> : t t.R t.P e.rest,
1061//      (e.clashes Unwatched (e.Re) t.P) e.rest;
1062      /*
1063       * Uncomment previous line and delete next one to activate
1064       * Split-Clashes function
1065       */
1066      (e.clashes (e.Re) t.P) e.rest;
1067  } :: (e.clashes) e.Snt,
1068  # \{
1069    e.Snt : \{
1070      (RESULT e.Re) (LEFT e) e = e.Re;
1071      (RESULT e.Re) (RIGHT e) e = e.Re;
1072    } :: e.Re,
1073      <Without-Calls? e.Re>;
1074  } =
1075  e.Snt : e.Current-Snt (Comp Sentence) e.Other-Snts =
1076  <Comp-Sentence () e.Other-Snts> :: e.asail-Others,
1077  {
1078//    <Split-Clashes (e.clashes) e.Current-Snt>
1079//    :: (e.greater) (e.less) (e.hards) (e.clashes) e.Current-Snt =
1080//      <WriteLN "Hards: " e.hards>,
1081//      <WriteLN "Less: " e.less>,
1082//      <WriteLN "Greater: " e.greater>,
1083//      <WriteLN "Current-Snt: " e.Current-Snt>,
1084//!                     <Comp-Clashes (e.clashes)
1085//!                             (e.Current-Snt (Comp Sentence)) e.Other-Snts> :: e.asail-Clashes,
1086//      e.asail-Clashes (e.greater) $iter {
1087//        e.greater : (e.vars s.num) e.rest,
1088//          <Old-Vars e.vars> :: e.vars,  // temporary step
1089//          (IF ((INFIX ">=" ((LENGTH e.vars)) (s.num)))
1090//            e.asail-Clashes
1091//          ) (e.rest);
1092//      } :: e.asail-Clashes (e.greater),
1093//      e.greater : /*empty*/ =
1094//      e.asail-Clashes (e.less) $iter {
1095//        e.less : (e.vars s.num) e.rest,
1096//          <Old-Vars e.vars> :: e.vars,  // temporary step
1097//          (IF ((INFIX "<=" ((LENGTH e.vars)) (s.num)))
1098//            e.asail-Clashes
1099//          ) (e.rest);
1100//      } :: e.asail-Clashes (e.less),
1101//      e.less : /*empty*/ =
1102//      e.asail-Clashes (e.hards) $iter {
1103//        e.hards : (e.Re) (e.Pe) e.rest,
1104//          <Old-Vars e.Re> :: e.Re,    // temporary step
1105//          <Old-Vars e.Pe> :: e.Pe,    // temporary step
1106//          (IF ((INFIX "==" (e.Re) (e.Pe))) e.asail-Clashes) (e.rest);
1107//      } :: e.asail-Clashes (e.hards),
1108//      e.hards : /*empty*/ =
1109//!                     e.asail-Clashes e.asail-Others;
1110    e.asail-Others;
1111//    <Comp-Sentence () e.Other-Snts>;
1112  };
1113
1114Without-Calls? e.Re =
1115  e.Re $iter {
1116    e.Re : t.Rt e.rest =
1117      t.Rt : {
1118        (CALL e) = $fail;
1119        (BLOCK e) = $fail;
1120        (PAREN e.Re1) = <Without-Calls? e.Re1>;
1121        t.symbol-or-var = /*empty*/;
1122      },
1123      e.rest;
1124  } :: e.Re,
1125  e.Re : /*empty*/;
1126
1127//Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts =
1128//  <WriteLN Clashes e.clashes>,
1129////  /*
1130////   * Collect in e.vars all varibles from all clashes.
1131////   */
1132////  () e.clashes $iter {
1133////    e.not-watched : (e.expr) e.rest = (e.vars <Vars e.expr>) e.rest;
1134////  } :: (e.vars) e.not-watched,
1135////  e.not-watched : /*empty*/ =
1136////  /*
1137////   * Rename all collected variables in all clashes. Never mind multiple
1138////   * occurences.
1139////   */
1140////  (e.clashes) e.vars $iter {
1141////    e.vars : (s.var-tag s.m (e.n) e.var-id) e.rest, {
1142////      <Known-Vars? (s.var-tag e.var-id)> =
1143////        e.var-id : e.NEW (e.QualifiedName),
1144////        <Subst ((s.var-tag s.m (e.n) e.var-id))
1145////          (((s.var-tag (s.var-tag NEW ("len" e.QualifiedName))
1146////          s.m (e.n) e.var-id))) e.clashes>;
1147////      s.m : e.n =
1148////        <Subst ((s.var-tag s.m (e.n) e.var-id))
1149////          (((s.var-tag (s.m) s.m (e.n) e.var-id))) e.clashes>;
1150////    } :: e.clashes,
1151////    (e.clashes) e.rest;
1152////  } :: (e.clashes) e.vars,
1153////  e.vars : /*empty*/ =
1154////  /*
1155////   * Now all variables with known length have ref. term after s.var-tag.
1156////   * Well, lets see if there are closed variables and compute their lengthes
1157////   * too.
1158////   */
1159////  e.clashes (e.clashes) () $iter {
1160////    e.not-watched : (e.Re) (s.dir e.Pe) e.rest, {
1161////      <Find-Closed-Var e.Pe> :: t.old-var t.new-var e.new-cond,
1162////        <Subst (t.old-var) ((t.new-var)) e.clashes> :: e.clashes,
1163////        e.clashes (e.clashes) (e.cond e.new-cond);
1164////      e.rest (e.clashes) (e.cond);
1165////    };
1166////  } :: e.not-watched (e.clashes) (e.cond),
1167////  e.not-watched : /*empty*/ =
1168//
1169//  /*
1170//   * Parenthesize each clash, so from now on they can be seen as a sequence
1171//   * of such terms: (e.temp-tags (e.Re) t.P)
1172//   */
1173//  e.clashes () $iter {
1174//    e.old-clashes : t.R t.P e.rest =
1175//      e.rest (e.clashes (t.R t.P));
1176//  } :: e.old-clashes e.clashes,
1177//  e.old-clashes : /*empty*/ =
1178// 
1179//  <Find-Known-Lengths e.clashes> :: (e.known-len-clashes) e.clashes,
1180//  {
1181//    e.known-len-clashes : /*empty*/ =
1182//      <Find-Symbol-Checks e.clashes> :: (e.sym-check-clashes) e.clashes,
1183//      {
1184//        e.sym-check-clashes : /*empty*/ =
1185//          e.clashes : {
1186//            (e.Re) (s.dir e.Pe) e.rest =
1187//              <Gener-Label L> :: t.label,
1188//              <Comp-Clashes (e.rest) (e.Current-Snt)
1189//                (Comp Continue t.label) e.Other-Snts>
1190//              :: e.asail-Snt,
1191//              (FOR t.label () () ()
1192//                e.asail-Snt
1193//              )
1194//              <Comp-Sentence () e.Other-Snts>;
1195//            /*empty*/ =
1196//              <Comp-Sentence () e.Current-Snt e.Other-Snts>;
1197//          };
1198//        <Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts> :: e.asail-Snt,
1199//          (e.sym-check-clashes) e.asail-Snt $iter {
1200//            e.sym-check-clashes : e.something (e (e.Re) (s.dir e.Pe)),
1201//             
1202//    <Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts> :: e.asail-Snt,
1203//      (e.known-len-clashes) e.asail-Snt $iter {
1204//        e.known-len-clashes : e.something (e.tags (e.Re) (s.dir e.Pe)),
1205//          (e.something)
1206//          (IF ((INFIX "==" (<Length-of e.Re>) (<Length-of e.Pe>)))
1207//            e.asail-Snt
1208//          );
1209//      } :: (e.known-len-clashes) e.asail-Snt,
1210//      e.known-len-clashes : /*empty*/ =
1211//      e.asail-Snt
1212//      <Comp-Sentence () e.Other-Snts>;
1213//  };
1214//
1215//Find-Known-Lengths e.clashes =
1216//  e.clashes () () $iter {
1217//    e.old-clashes : t.first e.rest, t.first : {
1218//      (e1 Known-length e2) =
1219//        e.rest (e.known) (e.clashes t.first);
1220//      (e.tags (e.Re) (s.dir e.Pe)) =
1221////        Known <Vars e.Re> <Vars e.Pe> $iter {
1222////          e.vars : (VAR t.name) e.rest-vars, {
1223////            <?? t.name Length> : e = Known;
1224////            <?? t.name Instantiated> : True = Known;
1225////            Unknown;
1226////          } :: s.known? =
1227////            s.known? e.rest-vars;
1228////        } :: s.known? e.vars,
1229////        \{
1230////          s.known? : Unknown =
1231////            e.rest (e.known) (e.clashes t.first);
1232////          e.vars : /*empty*/ =
1233////            e.rest (e.known t.first)
1234////            (e.clashes (e.tags Known-length (e.Re) (s.dir e.Pe)));
1235////        };
1236//        {
1237//          <Hard-Exp? <Vars e.Re> <Vars e.Pe>> =
1238//            e.rest (e.known t.first)
1239//            (e.clashes (e.tags Known-length (e.Re) (s.dir e.Pe)));
1240//          e.rest (e.known) (e.clashes t.first);
1241//        };
1242//    };
1243//  } :: e.old-clashes (e.known) (e.clashes),
1244//  e.old-clashes : /*empty*/ =
1245//  (e.known) e.clashes;
1246//
1247//Known-Vars? e.vars =
1248//  <? &Var-Stack> :: e.known-vars,
1249//  e.vars $iter {
1250//    e.vars : t.var e.rest =
1251//      e.known-vars : e t.var e,
1252//      e.rest;
1253//  } :: e.vars,
1254//  e.vars : /*empty*/;
1255
1256$func CC (e.clashes) s.tail? (v.fails) e.Snt = e.asail-Snt;
1257
1258$const New-Clash-Tags = Unknown-length Ties Check-symbols Deref Compare;
1259
1260Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence =
1261//  <WriteLN Clashes e.clashes>,
1262  /*
1263   * Parenthesize each clash, so from now on they can be seen as a sequence
1264   * of such terms: (e.temp-tags (e.Re) t.P)
1265   */
1266  e.clashes () $iter {
1267    e.old-clashes : (e.Re) (s.dir e.Pe) e.rest =
1268      <Comp-Static-Exprs (e.Re) (e.Pe)> : (e.R1) (e.P1),
1269      <Map &Ref-Set-Var (<Vars e.R1 e.P1>)> : e,
1270      e.rest (e.clashes (<Gener-Label "clash"> &New-Clash-Tags (e.R1) (s.dir e.P1)));
1271  } :: e.old-clashes (e.clashes),
1272  e.old-clashes : /*empty*/ =
1273  <CC (e.clashes) s.tail? (v.fails) e.Sentence>;
1274
1275$func Get-Known-Length e.expr = e.length-of-known-part (e.unknown-vars);
1276
1277$func Cyclic-Restr (e.fail) (e.watched-clashes) e.clashes = e.cond (e.clashes);
1278
1279$func Deref-Exprs
1280    (e.fail) (e.conds) (e.assigns) e.clashes = e.clashes (e.conds) (e.assigns);
1281
1282$func Compare-Subexprs (e.fail) (e.conds) e.clashes = e.clashes (e.conds);
1283
1284$func? Comp-Cycle e.clashes = t t t e.clashes;
1285
1286$func Assign-Value e = e;
1287
1288CC (e.clashes) s.tail? (e.prev-fails (e.fail)) e.Snt, {
1289  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2,
1290    <Get-Known-Length e.Re> :: e.len-Re (e.vars-Re),
1291    <Get-Known-Length e.Pe> :: e.len-Pe (e.vars-Pe),
1292    \{
1293      /*
1294       * Если длины всех переменных на верхних уровнях e.Re и e.Pe
1295       * известны, то надо просто выписать условие на равенство длин
1296       * выражения и образца.
1297       */
1298      e.vars-Re : /*empty*/, e.vars-Pe : /*empty*/ =
1299        (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
1300        <CC (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2)
1301          s.tail? (e.prev-fails (e.fail)) e.Snt>;
1302      /*
1303       * Если неизвестная переменная во всём клеше ровно одна, и она
1304       * входит в левую и правую части разное кол-во раз, то её длину
1305       * можно вычислить.
1306       *
1307       * Если же она входит в левую и правую части одинаковое кол-во раз,
1308       * то остальные составляющие клеша проверяются на равенство, и он
1309       * объявляется циклическим до вычисления этой переменной.
1310       */
1311      <Nub e.vars-Re e.vars-Pe> : t.var, {
1312        <"-" <Length e.vars-Re> <Length e.vars-Pe>> :: s.diff,
1313          <"/=" (s.diff) (0)> =
1314          {
1315            <"<" (s.diff) (0)> = <"*" s.diff -1> (e.len-Re) (e.len-Pe);
1316            s.diff (e.len-Pe) (e.len-Re);
1317          } :: s.mult (e.minuend) (e.subtrahend),
1318          <Create-Int-Var ("len") Aux e.minuend> :: t.m-var e.m-assign,
1319          <Create-Int-Var ("len") Aux e.subtrahend> :: t.s-var e.s-assign,
1320          <Get-Var Min t.var> :: e.min,
1321          ((INFIX "<" (t.m-var)
1322                ((INFIX "+" (t.s-var)
1323                      ((INFIX "*" (e.min) (s.mult)))
1324          ))                    )) :: e.min-cond,
1325          <Get-Var Max t.var> : {
1326            /*empty*/;
1327            e.max =
1328              ((INFIX ">" (t.m-var)
1329                    ((INFIX "+" (t.s-var)
1330                          ((INFIX "*" (e.max) (s.mult)))
1331              ))                        ));
1332          } :: e.max-cond,
1333          (INFIX "%" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult)) :: e.div-cond,
1334          <Create-Int-Var ("len_") t.var
1335            (INFIX "/" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult))
1336          > :: t.len-var e.len-assign,
1337          <Set-Var (Length t.len-var) t.var>,
1338          e.m-assign e.s-assign
1339          (IF ((INFIX "||" e.min-cond e.max-cond)) e.fail)
1340          (IF (e.div-cond) e.fail)
1341          e.len-assign
1342          <CC (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2)
1343            s.tail? (e.prev-fails (e.fail)) e.Snt>;
1344
1345        (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
1346          <CC (e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2)
1347            s.tail? (e.prev-fails (e.fail)) e.Snt>;
1348      };
1349    };
1350
1351  /*
1352   * Перебрали все клеши, из которых можно было вычислить что-то определённое
1353   * про длины.
1354   *
1355   * Теперь выпишем неравенства на длины, накладываемые остальными клешами.
1356   */
1357  <Cyclic-Restr (e.fail) (/*e.watched*/) e.clashes> :: e.cond (e.clashes),
1358
1359    <Deref-Exprs (e.fail) (/*e.conds*/) (/*e.assigns*/) e.clashes> : {
1360      e.new-clashes (v.conds) (v.assigns) =
1361        e.cond v.conds v.assigns
1362        <CC (e.new-clashes) s.tail? (e.prev-fails (e.fail)) e.Snt>;
1363
1364      /*
1365       * If previous doesn't work then compare recursively all known
1366       * subexpressions and all unknown repeated subexpressions with
1367       * corresponding parts of source.
1368       */
1369      e.new-clashes () () =
1370        <Compare-Subexprs (e.fail) () e.new-clashes> :: e.clashes (e.cond2),
1371        e.new-clashes (/*e.assigns*/) $iter {
1372          e.new-clashes : (e (e.Re) (s.dir e.Pe)) e.rest =
1373            e.rest (e.assigns <Map &Assign-Value (<Vars e.Pe>)>);
1374        } :: e.new-clashes (e.assigns),
1375        e.new-clashes : /*empty*/ =
1376        {
1377          <Comp-Cycle e.clashes> :: t.var t.l-var t.r-var e.clashes =
1378            <Gener-Label L "For" "Cont"> :: t.cont-label,
1379            <Gener-Label L "For" "Break"> :: t.break-label,
1380            e.cond e.cond2 e.assigns
1381            (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
1382            (LABEL (t.break-label)
1383              (FOR (t.cont-label) () ((INC-ITER t.var))
1384                <CC (e.clashes) s.tail?
1385                  (e.prev-fails (e.fail))
1386                  (Comp Fail ((CONTINUE t.cont-label))) e.Snt>
1387                (BREAK t.break-label)
1388              )
1389            );
1390          e.cond e.cond2 e.assigns
1391          <Comp-Sentence s.tail? (e.prev-fails (e.fail)) () e.Snt>;
1392        };
1393    };
1394};
1395
1396
1397
1398Assign-Value t.var =
1399  {
1400    <Get-Var Value t.var> : (expr) (e.pos) (e.len) =
1401      (SUBEXPR t.var expr (e.pos) (e.len));
1402    /*empty*/;
1403  };
1404
1405
1406
1407$func  Get-Min e = e;
1408
1409$func? Get-Max e = e;
1410
1411Cyclic-Restr (e.fail) (e.watched) e.clashes, {
1412  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2,
1413    <Get-Known-Length e.Re> :: e.len-Re (e.vars-Re),
1414    <Get-Known-Length e.Pe> :: e.len-Pe (e.vars-Pe),
1415    {
1416      <Get-Max e.vars-Re> :: e.max =
1417        <Get-Min e.vars-Pe> :: e.min,
1418        ((INFIX "<" (e.len-Re e.max) (e.len-Pe e.min)));
1419      /*empty*/;
1420    } :: e.cond1,
1421    {
1422      <Get-Max e.vars-Pe> :: e.max =
1423        <Get-Min e.vars-Re> :: e.min,
1424        ((INFIX ">" (e.len-Re e.min) (e.len-Pe e.max)));
1425      /*empty*/;
1426    } :: e.cond2,
1427    {
1428      e.cond1 : /*empty*/, e.cond2 : /*empty*/ = /*empty*/;
1429      (IF ((INFIX "||" e.cond1 e.cond2)) e.fail);
1430    } :: e.cond,
1431    e.cond
1432    <Cyclic-Restr (e.fail) (e.watched e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe))) e2>;
1433  (e.watched e.clashes);
1434};
1435
1436Get-Min
1437{
1438  t.var e.vars = <Get-Var Min t.var> <Get-Min e.vars>;
1439  /*empty*/ = /*empty*/;
1440};
1441
1442Get-Max
1443{
1444  t.var e.vars = <Get-Var Max t.var> : v.max, v.max <Get-Max e.vars>;
1445  /*empty*/ = /*empty*/;
1446};
1447
1448
1449
1450*       /*e.cond*/ (/*!e.clashes!*/) (/*e.fail*/) $iter {
1451*               /*
1452*                * First of all see if we have a clash with all variables of known length
1453*                * and without length conditions written out.
1454*                */
1455*               e.clashes : e1 (e.t1 Known-length e.t2 (e.Re) (s.dir e.Pe)) e2,
1456*                       <Hard-Exp? e.Re e.Pe> =
1457*                       e.cond
1458*                       (Cond IF ((INFIX "==" (<Length-of e.Re>) (<Length-of e.Pe>))))
1459*                       (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2) (e.fail);
1460*               /*
1461*                * Next see if we can compute length of some variable.
1462*                */
1463*               e.cond <Find-Var-Length e.clashes> (e.fail);
1464*               /*
1465*                * Write out restrictions for the cyclic variables.
1466*                */
1467*               e.cond <Cyclic-Restrictions e.clashes> (e.fail);
1468* //            <Cyclic-Restrictions e.clashes> :: e.new-cond (e.clashes),
1469* //                    {
1470* //                            e.fail : v = e.cond e.new-cond (Clear-Restricted) (e.clashes) (e.fail);
1471* //                            e.cond e.new-cond (e.clashes) (e.fail);
1472* //                    };
1473*               /*
1474*                * After checking all possible lengthes at the upper level change
1475*                * <<current_label_if_fail>>.
1476*                */
1477*               e.fail : v =
1478*                       (Contin e.fail) e.cond (Fail e.fail) (Clear-Restricted) (e.clashes) ();
1479*               /*
1480*                * For all clashes with known left part check unwatched terms whether they
1481*                * are symbols or reference terms or not any.
1482*                */
1483*               \?
1484*               {
1485*                       <Check-Symbols e.clashes> : {
1486*                               v.new-cond (e.new-clashes) s =
1487*                                       e.cond (Cond IF (v.new-cond)) (e.new-clashes) ();
1488*                               (e.new-clashes) New = e.cond (e.new-clashes) ();
1489*                               e \! $fail;
1490*                       };
1491*                       <PrintLN "Check-Symbols: don't know what to do... ;-)">, $fail;
1492*               };
1493*               /*
1494*                * And then try to compose new clash by dereferencing a part of some one.
1495*                */
1496*               e.cond <Dereference-Subexpr e.clashes> ();
1497*               /*
1498*                * If previous doesn't work then compare recursively all known
1499*                * subexpressions and all unknown repeated subexpressions with
1500*                * corresponding parts of source.
1501*                */
1502*               <Compare-Subexpr e.clashes> :: e.new-cond (e.asserts) (e.new-clashes) s.new?,
1503*                       \{
1504*                               e.new-cond : v, {
1505*                                       e.asserts : v =
1506*                                               e.cond (Assert e.asserts) (Cond IF (e.new-cond)) (e.new-clashes) ();
1507*                                       e.cond (Cond IF (e.new-cond)) (e.new-clashes) ();
1508*                               };
1509*                               e.asserts : v = e.cond (Assert e.asserts) (e.new-clashes) ();
1510*                               s.new? : New = e.cond (e.new-clashes) ();
1511*                       };
1512*               /*
1513*                * Then get first uncatenated source and bring it to the normal
1514*                * form, i.e. concatenate and parenthesize until it became single
1515*                * known expression.
1516*                */
1517*               e.cond <Get-Source e.clashes> ();
1518*               /*
1519*                * Now it's time to deal with cycles.
1520*                */
1521*               e.cond <Comp-Cyclic e.clashes>;
1522*               /*
1523*                * At last initialize all new subexpressions from all clashes.
1524*                */
1525*               e.clashes () $iter {
1526*                       e.clashes : (e t.Re (s.dir e.Pe)) e.rest,
1527*                               e.rest (e.new-cond <Get-Subexprs <Vars e.Pe>>);
1528*               } :: e.clashes (e.new-cond),
1529*                       e.clashes : /*empty*/ =
1530*                       {
1531*                               e.new-cond : /*empty*/ = e.cond () ();
1532*                               e.cond (Assert e.new-cond) () ();
1533*                       };
1534*       } :: e.cond (e.clashes) (e.fail),
1535* //    <WriteLN CC-Clashes e.clashes>,
1536* //    <WriteLN CC-Cond e.cond>,
1537*       e.clashes : /*empty*/ =
1538*
1539*       e.cond () 0 $iter {
1540*               e.cond : (Contin (CONTINUE t.label)) e.rest =
1541*                       e.rest (e.contin (Comp Continue t.label)) 0;
1542*               e.cond (e.contin) 1;
1543*       } :: e.cond (e.contin) s.stop?,
1544*       s.stop? : 1 =
1545* //!   <Comp-Sentence () e.Current-Snt e.contin e.Other-Snts> :: e.asail-Snt,
1546*       <Comp-Sentence s.tail? (v.fails) () e.Sentence> :: e.asail-Snt,
1547*       e.cond (e.asail-Snt) () $iter {
1548*               e.cond : e.some (e.last),
1549*                       e.last : {
1550*                               Cond e.condition =
1551*                                       e.some ((e.condition e.asail-Snt)) (e.vars);
1552*                               Assert e.assertion =
1553*                                       e.some (e.assertion e.asail-Snt) (e.vars);
1554*                               Fail e.fail1 =
1555*                                       e.some (e.asail-Snt e.fail1) (e.vars);
1556*                               Restricted t.var =
1557*                                       e.some (e.asail-Snt) (e.vars t.var);
1558*                               If-not-restricted t.var e.restr-cond, {
1559*                                       e.vars : e t.var e = e.some (e.asail-Snt) (e.vars);
1560*                                       e.some e.restr-cond (e.asail-Snt) (e.vars);
1561*                               };
1562*                               Clear-Restricted = e.some (e.asail-Snt) ();
1563*                       };
1564*       } :: e.cond (e.asail-Snt) (e.vars),
1565*       e.cond : /*empty*/ =
1566*       e.asail-Snt/* <Comp-Sentence () e.Other-Snts>*/;
1567
1568
1569Find-Var-Length (e.fail) e.clashes =
1570//  <WriteLN Find-Var-Length e.clashes>,
1571  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 \?
1572  <Unknown-Vars e.Pe> :: e.new-Pe (e.Pe-unknown),
1573  <Unknown-Vars e.Re> :: e.new-Re (e.Re-unknown),
1574//  <Write Unknown>, <Write (e.Re-unknown)>, <WriteLN (e.Pe-unknown)>,
1575  e.Re-unknown e.Pe-unknown : {
1576    /*empty*/ =
1577      (e1 (e.t1 Known-length e.t2 (e.Re) (s.dir e.Pe)) e2);
1578    (VAR t.name) e.rest,
1579      e.rest $iter \{
1580        e.unknown : (VAR t.name) e.rest1 = e.rest1;
1581      } :: e.unknown,
1582      e.unknown : /*empty*/,
1583      <"-" <Length e.Re-unknown> <Length e.Pe-unknown>> : {
1584        0 \! $fail;
1585        s.diff, {
1586          <"<" (s.diff) (0)> =
1587            <"*" s.diff -1>
1588            (INFIX "-" (<Length-of e.new-Re>) (<Length-of e.new-Pe>));
1589          <">" (s.diff) (0)> =
1590            s.diff
1591            (INFIX "-" (<Length-of e.new-Pe>) (<Length-of e.new-Re>));
1592        } :: s.mult e.diff,
1593          t.name : (e.QualifiedName),
1594          (VAR ("len" e.QualifiedName)) :: t.len-var,
1595          {
1596            <?? t.name Max> :: e.max =
1597              (INFIX "<="
1598                (t.len-var)
1599                ((INFIX "*" (s.mult) (e.max)))
1600              );
1601            /*empty*/;
1602          } :: e.cond,
1603          e.cond
1604          (INFIX ">="
1605            (t.len-var)
1606            ((INFIX "*" (s.mult) (<?? t.name Min>)))
1607          )
1608          (NOT (INFIX "%"
1609            (t.len-var)
1610            (s.mult)
1611          )) :: e.cond,
1612          <Set-Var t.name (Max) (//(LENGTH (VAR t.name))
1613            (INFIX "/" (t.len-var) (s.mult))
1614          )>,
1615          <Set-Var t.name (Min) (<?? t.name Max>)>,
1616          <Set-Var t.name (Length) (<?? t.name Max>)>,
1617//          <WriteLN Unknown-Num s.mult> =
1618          (Restricted (VAR t.name))
1619          (Assert
1620            <Declare-Vars "int" t.len-var>
1621            (ASSIGN t.len-var e.diff)
1622          )
1623          (Cond IF (e.cond))
1624          (<Update-Ties (VAR t.name) e1>
1625            (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe))
1626          <Update-Ties (VAR t.name) e2>);
1627      };
1628    e.unknown \!
1629      e.t1 Unknown-length e.t2 : e.t3 Ties e.t4 =
1630      e.t1 : t.id e,
1631      e.unknown () $iter {
1632        e.unknown : (VAR t.name) e.rest, {
1633          e.tied : e (VAR t.name) e = e.rest (e.tied);
1634          <Entries (VAR t.name) (e.Re)> :: s.Re-ent e.new-Re,
1635            <Entries (VAR t.name) (e.Pe)> :: s.Pe-ent e.new-Pe,
1636            <"-" s.Re-ent s.Pe-ent> :: s.diff,
1637            {
1638              s.diff : 0 = e.rest (e.tied (VAR t.name));
1639              {
1640                <"<" (s.diff) (0)> =
1641                  <"*" s.diff -1> (e.new-Re) (e.new-Pe);
1642                s.diff (e.new-Pe) (e.new-Re);
1643              } :: s.diff (e.plus) (e.minus),
1644                (
1645                  t.id
1646                  (<Known-Length-of e.plus>)
1647                  (<Known-Length-of e.minus>)
1648                  s.diff
1649                ) :: t.tie,
1650                {
1651                  <?? t.name Ties> : {
1652                    e.c1 (t.id e) e.c2 = e.c1 e.c2;
1653                    e.ties = e.ties;
1654                  };
1655                  /*empty*/;
1656                } :: e.ties,
1657                {
1658                  e.ties : e t.tie e;
1659                  <Set-Var t.name (Ties) (e.ties t.tie)>;
1660                },
1661                e.rest (e.tied (VAR t.name));
1662            };
1663        };
1664      } :: e.unknown (e.tied),
1665      e.unknown : /*empty*/ =
1666      {
1667        e.t3 e.t4 : e Cyclic e = e.t3 e.t4;
1668        e.t3 e.t4 Cyclic;
1669      } :: e.tags,
1670      (e1 (e.tags (e.Re) (s.dir e.Pe)) e2);
1671  };
1672
1673Known-Length-of e.expr =
1674  <Unknown-Vars e.expr> :: e.expr (e.vars),
1675  <Length-of e.expr> (e.vars);
1676
1677Update-Ties t.var e.clashes =
1678  e.clashes () $iter {
1679    e.clashes : t.clash e.rest,
1680      t.clash : (e.tags (e.Re) (s.dir e.Pe)),
1681      {
1682        e.tags : e Ties e = e.rest (e.new-clashes t.clash);
1683        e.Re e.Pe : e t.var e =
1684          e.rest (e.new-clashes (e.tags Ties (e.Re) (s.dir e.Pe)));
1685        e.rest (e.new-clashes t.clash);
1686      };
1687  } :: e.clashes (e.new-clashes),
1688  e.clashes : /*empty*/ =
1689  e.new-clashes;
1690
1691Cyclic-Restrictions e.clashes =
1692  e.clashes : e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2 =
1693  <Unknown-Vars e.Re e.Pe> :: e (e.unknown),
1694  e.unknown () $iter {
1695    e.unknown : t.var e.rest,
1696      t.var : (VAR (e.QualifiedName)),
1697      (VAR ("min" e.QualifiedName)) :: t.min-var,
1698      <Cyclic-Min t.var> :: e.min,
1699      {
1700        <Cyclic-Max t.var> :: e.max =
1701          e.rest (e.cond (Restricted t.var) (If-not-restricted t.var
1702            (Assert
1703              <Declare-Vars "int" t.min-var> (ASSIGN t.min-var e.min)
1704            )
1705            (Cond IF ((INFIX "<=" (t.min-var) (e.max))))
1706        ));
1707        e.rest (e.cond);
1708      };
1709  } :: e.unknown (e.cond),
1710  e.unknown : /*empty*/ =
1711  e.cond (e1 (e.t1 e.t2 (e.Re) (s.dir e.Pe)) e2);
1712
1713Cyclic-Min (VAR t.name) =
1714  <?? t.name Ties> () $iter {
1715    e.ties : (t (e.plus (e.plus-vars)) (e.minus (e.minus-vars)) s.mult) e.rest, {
1716      e.minus-vars () $iter \{
1717        e.minus-vars : t.var e.vars-rest,
1718          e.vars-rest (e.minus-maxes <Cyclic-Max t.var>);
1719      } :: e.minus-vars (e.minus-maxes),
1720        e.minus-vars : /*empty*/ =
1721        e.plus-vars () $iter {
1722          e.plus-vars : (VAR t.var-name) e.vars-rest =
1723            e.vars-rest (e.plus-mins <?? t.var-name Min>);
1724        } :: e.plus-vars (e.plus-mins),
1725        e.plus-vars : /*empty*/ =
1726        e.rest (e.mins ((INFIX "/"
1727          ((INFIX "-" (e.plus e.plus-mins) (e.minus e.minus-maxes))) (s.mult)
1728        )));
1729      e.rest (e.mins);
1730    };
1731  } :: e.ties (e.mins),
1732  e.ties : /*empty*/ =
1733  (<?? t.name Min>) e.mins :: e.mins,
1734  {
1735    e.mins : (e.min) = e.min;
1736    (MAX e.mins);
1737  };
1738
1739Cyclic-Max (VAR t.name) =
1740  <?? t.name Ties> () $iter {
1741    e.ties : (t (e.plus (e.plus-vars)) (e.minus (e.minus-vars)) s.mult) e.rest, {
1742      e.plus-vars () $iter \{
1743        e.plus-vars : (VAR t.var-name) e.vars-rest,
1744          e.vars-rest (e.plus-maxes <?? t.var-name Max>);
1745      } :: e.plus-vars (e.plus-maxes),
1746        e.plus-vars : /*empty*/ =
1747        e.minus-vars () $iter {
1748          e.minus-vars : (VAR t.var-name) e.vars-rest =
1749            e.vars-rest (e.minus-mins <?? t.var-name Min>);
1750        } :: e.minus-vars (e.minus-mins),
1751        e.minus-vars : /*empty*/ =
1752        e.rest (e.maxes ((INFIX "/"
1753          ((INFIX "-" (e.plus e.plus-maxes) (e.minus e.minus-mins))) (s.mult)
1754        )));
1755      e.rest (e.maxes);
1756    };
1757  } :: e.ties (e.maxes),
1758  e.ties : /*empty*/ =
1759  {
1760    (<?? t.name Max>) e.maxes;
1761    e.maxes;
1762  } :: e.maxes,
1763  {
1764    e.maxes : /*empty*/ = $fail;
1765    e.maxes : (e.max) = e.max;
1766    (MIN e.maxes);
1767  };
1768
1769Check-Symbols e.clashes =
1770  e.clashes () () Old $iter {
1771    e.clashes : t.clash e.rest, {
1772      t.clash : (e.t1 Check-symbols e.t2 (e.Re) (s.dir e.Pe)),
1773        e.Re : (VAR t.name),
1774        <?? t.name Instantiated> : True =
1775//        <Format e.Pe> () () Continue $iter {
1776        e.Pe () () Continue $iter {
1777          e.format : t.Ft e.Fe =
1778            <Length-of e.left> :: e.pos,
1779            <Check-Ft t.Ft (e.pos) (1 <Length-of e.Fe>) t.name Left-checks> : {
1780              /*empty*/ s.stop??? = /*empty*/ s.stop???;
1781              Sym s.stop??? =
1782                (Used e.Re) (SYMBOL? e.Re (e.pos)) s.stop???;
1783              Ref s.stop??? =
1784                (Used e.Re) (NOT (SYMBOL? e.Re (e.pos))) s.stop???;
1785              Flat e.len s.stop??? =
1786                (Used e.Re) (FLAT-SUBEXPR? e.Re (e.pos) (e.len)) s.stop???;
1787            } :: e.Ft-cond s.stop? =
1788            e.Fe (e.left t.Ft) (e.new-cond e.Ft-cond) s.stop?;
1789        } :: e.format (e.left) (e.new-cond) s.stop?,
1790        \{
1791          e.format : /*empty*/ =
1792            e.rest (e.cond e.new-cond)
1793            (e.new-clashes (e.t1 e.t2 (e.Re) (s.dir e.Pe))) New;
1794          s.stop? : Stop =
1795            e.format () (e.new-cond) Continue $iter {
1796              e.format : e.Fe t.Ft =
1797                1 <Length-of e.right> :: e.pos,
1798                <Check-Ft t.Ft (e.pos) () t.name Right-checks>
1799                  :: e.Ft-cond s.stop?,
1800                e.Ft-cond : {
1801                  /*empty*/ = /*empty*/;
1802                  Sym =
1803                    (Used e.Re)
1804                    (SYMBOL? e.Re (
1805                      (INFIX "-" (<Length-of e.Re>) (e.pos))
1806                    ));
1807                  Ref =
1808                    (Used e.Re)
1809                    (NOT (SYMBOL? e.Re (
1810                      (INFIX "-" (<Length-of e.Re>) (e.pos))
1811                    )));
1812                  Flat e.len s.stop??? =
1813                    (Used e.Re)
1814                    (FLAT-SUBEXPR? e.Re (
1815                      (INFIX "-" (<Length-of e.Re>) (e.pos))
1816                    ) e.len) s.stop???;
1817                } :: e.Ft-cond,
1818                e.Fe (t.Ft e.right) (e.new-cond e.Ft-cond) s.stop?;
1819            } :: e.format (e.right) (e.new-cond) s.stop?,
1820            s.stop? : Stop =
1821            e.rest (e.cond e.new-cond) (e.new-clashes t.clash) s.new?;
1822        };
1823      e.rest (e.cond) (e.new-clashes t.clash) s.new?;
1824    };
1825  } :: e.clashes (e.cond) (e.new-clashes) s.new?,
1826//  <WriteLN Check-Symbols e.clashes (e.cond) (e.new-clashes) s.new?>,
1827  e.clashes : /*empty*/ =
1828  e.cond (e.new-clashes) s.new?;
1829
1830Check-Ft t.Ft (e.pos) (e.right-pos) t.name s.dir, t.Ft : {
1831  s.ObjectSymbol, {
1832    <?? t.name s.dir> : \{
1833      e (e.pos Sym) e = /*empty*/ Continue;
1834      e (e.pos (Ref e)) e = $fail;
1835    };
1836    s.dir : Left-checks,
1837      <?? t.name Right-checks> : \{
1838        e (e.right-pos Sym) e = /*empty*/ Continue;
1839        e (e.right-pos (Ref e)) e = $fail;
1840      };
1841    <Set-Var t.name (s.dir) (<?? t.name s.dir> (e.pos Sym))> = Sym Continue;
1842  };
1843  (PAREN e.expr), {
1844    <?? t.name s.dir> : \{
1845      e (e.pos (Ref e)) e = /*empty*/ Continue;
1846      e (e.pos Sym) e = $fail;
1847    };
1848    s.dir : Left-checks,
1849      <?? t.name Right-checks> : \{
1850        e (e.right-pos (Ref e)) e = /*empty*/ Continue;
1851        e (e.right-pos Sym) e = $fail;
1852      };
1853    s.dir : {
1854      Left-checks = "lderef";
1855      Right-checks = "rderef";
1856    } :: s.name-dir,
1857      t.name : (e.QualifiedName),
1858      <Gener-Label s.name-dir e.QualifiedName> :: t.ref-name,
1859//      <Declare-Vars "Expr" (VAR t.ref-name)> : e,
1860      <Set-Var t.name (s.dir) (<?? t.name s.dir> (e.pos (Ref t.ref-name)))> =
1861      Ref Continue;
1862  };
1863//!     (VAR t.Ft-name), {
1864  (s t.Ft-name), { // STUB!
1865    <Hard-Exp? t.Ft>, {
1866      <?? t.Ft-name Flat> : True, {
1867        <?? t.Ft-name Length> : 1, {
1868          <?? t.name s.dir> : \{
1869            e (e.pos Sym) e = /*empty*/ Continue;
1870            e (e.pos (Ref e)) e = $fail;
1871          };
1872          s.dir : Left-checks,
1873            <?? t.name Right-checks> : \{
1874              e (e.right-pos Sym) e = /*empty*/ Continue;
1875              e (e.right-pos (Ref e)) e = $fail;
1876            };
1877//          <?? t.Ft-name Instantiated> : True =
1878//            /*empty*/ Continue;
1879          <Set-Var t.name (s.dir) (<?? t.name s.dir> (e.pos Sym))> =
1880            Sym Continue;
1881        };
1882        <Set-Var t.name (s.dir) (<?? t.name s.dir> (e.pos Flat))> =
1883          Flat <Length-of t.Ft> Continue;
1884      };
1885      /*empty*/ Continue;
1886    };
1887    /*empty*/ Stop;
1888  };
1889};
1890
1891Dereference-Subexpr e.clashes =
1892  e.clashes : e1 (e.t1 Dereference e.t2 (e.Re) (s.dir e.Pe)) e2 \?
1893  e.Re : (VAR t.name),
1894  <?? t.name Instantiated> : True,
1895//  <WriteLN Dereference!!! t.name <?? t.name Right-checks>>,
1896//  <Format e.Pe> : e.f1 t.Ft e.f2 \?
1897  e.Pe : e.f1 t.Ft e.f2 \?
1898  \{
1899    t.Ft : (PAREN e.expr),
1900      <Length-of e.f1> :: e.pos,
1901      {
1902        <?? t.name Left-checks> : e (e.pos (Ref t.ref-name)) e \!
1903          # \{ <?? t.ref-name Instantiated> : True; } =
1904          <Declare-Vars "Expr" (VAR t.ref-name)> : e,
1905          <Instantiate-Vars (VAR t.ref-name)>,
1906          (Assert (DEREF (VAR t.ref-name) e.Re (e.pos))) :: e.cond,
1907          (e.t1 Dereference e.t2 (e.Re) (s.dir e.Pe)) :: t.old-clash,
1908          {
1909            e.t1 e.t2 : e Without-object-symbols e = Without-object-symbols;
1910            /*empty*/;
1911          } :: e.wos,
1912          (<Gener-Label "clash"> &New-Clash-Tags e.wos
1913            ((VAR t.ref-name)) (s.dir e.expr)
1914          ) :: t.new-clash,
1915          s.dir : {
1916            LEFT =
1917              e.cond (e1 t.new-clash t.old-clash e2);
1918            RIGHT =
1919              e.cond (e1 t.old-clash t.new-clash e2);
1920          };
1921        t.Ft e.f2 : $r e.f3 (PAREN e.expr1) e.f4 \?
1922          1 <Length-of e.f4> :: e.pos,
1923          {
1924            <?? t.name Right-checks> : e (e.pos (Ref t.ref-name)) e \!
1925              # \{ <?? t.ref-name Instantiated> : True; } =
1926              <Declare-Vars "Expr" (VAR t.ref-name)> : e,
1927              <Instantiate-Vars (VAR t.ref-name)>,
1928              (Assert
1929                (DEREF (VAR t.ref-name) e.Re (
1930                  (INFIX "-" (<Length-of e.Re>) (e.pos))
1931                ))
1932              ) :: e.cond,
1933              (e.t1 Dereference e.t2 (e.Re) (s.dir e.Pe)) :: t.old-clash,
1934              {
1935                e.t1 e.t2 : e Without-object-symbols e =
1936                  Without-object-symbols;
1937                /*empty*/;
1938              } :: e.wos,
1939              (<Gener-Label "clash"> &New-Clash-Tags e.wos
1940                ((VAR t.ref-name)) (s.dir e.expr1)
1941              ) :: t.new-clash,
1942              s.dir : {
1943                RIGHT =
1944                  e.cond (e1 t.new-clash t.old-clash e2);
1945                LEFT =
1946                  e.cond (e1 t.old-clash t.new-clash e2);
1947              };
1948            \!\!\! $fail;
1949          };
1950        \!\! $fail;
1951      };
1952    e.f2 : /*empty*/ =
1953      (e1 (e.t1 e.t2 (e.Re) (s.dir e.Pe)) e2);
1954  };
1955
1956
1957
1958$func Deref-Left  (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
1959  e.Pe (e.conds) (e.assigns) (e.clashes) (e.rest-Pe);
1960
1961$func Deref-Right (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
1962  e.Pe (e.conds) (e.assigns) (e.clashes) (e.rest-Pe);
1963
1964Deref-Exprs (e.fail) (e.conds) (e.assigns) e.clashes, {
1965  e.clashes : e1 (e.t1 Deref e.t2 (e.Re) (s.dir e.Pe)) e2 =
1966    <Deref-Left  (e.fail) () () () (0) (e.Re) e.Pe>
1967      :: e.l-Pe (e.l-conds) (e.l-assigns) (e.l-clashes) (e.rest-Pe),
1968    <Deref-Right (e.fail) () () () (0) (e.Re) e.rest-Pe>
1969      :: e.r-Pe (e.r-conds) (e.r-assigns) (e.r-clashes) (e.Pe),
1970    e1 e.l-clashes (e.t1 e.t2 (e.Re) (s.dir e.l-Pe e.Pe e.r-Pe)) e.r-clashes
1971    <Deref-Exprs (e.fail)
1972            (e.conds e.l-conds e.r-conds)
1973            (e.assigns e.l-assigns e.r-assigns) e2>;
1974  e.clashes (e.conds) (e.assigns);
1975};
1976
1977Deref-Left (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe, {
1978  e.Pe : t.Pt e.rest, {
1979    <Get-Known-Length t.Pt> : e.len (), {
1980      t.Pt : (PAREN expr) =
1981        <Gener-Vars ((VAR)) "deref" e.Re> : t.var,
1982        <Set-Var (Instantiated? True) t.var>,
1983        (PAREN t.var)
1984        ((IF ((SYMBOL? e.Re (e.pos))) e.fail))
1985        ((DEREF t.var e.Re (e.pos)))
1986        ((<Gener-Label "clash"> &New-Clash-Tags (t.var) (LEFT expr)));
1987      t.Pt () () ();
1988    } :: t.Pt (e.cond) (e.assign) (e.clash) =
1989      t.Pt
1990      <Deref-Left (e.fail)
1991            (e.conds e.cond) (e.assigns e.assign) (e.clashes e.clash)
1992            (e.pos e.len) (e.Re) e.rest>;
1993    (e.conds) (e.assigns) (e.clashes) (e.Pe);
1994  };
1995  (e.conds) (e.assigns) (e.clashes) ();
1996};
1997
1998Deref-Right (e.fail) (e.conds) (e.assigns) (e.clashes) (e.pos) (e.Re) e.Pe =
1999  () () () (e.Pe);
2000
2001
2002
2003$func Compare-Terms-Left  (e.fail) (e.pos) (e.Re) e.Pe = e.cond (e.rest-Pe);
2004$func Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = e.cond (e.rest-Pe);
2005
2006Compare-Subexprs (e.fail) (e.conds) e.clashes, {
2007  e.clashes : (e.t (e.Re) (s.dir e.Pe)) e.rest =
2008    <Compare-Terms-Left (e.fail) (0) (e.Re) e.Pe> :: e.l-cond (e.rest-Pe),
2009    <Compare-Terms-Right (e.fail) (0) (e.Re) e.rest-Pe> :: e.r-cond (e.Pe),
2010    {
2011      e.Pe : /*empty*/ = /*empty*/;
2012      (e.t (e.Re) (s.dir e.Pe));
2013    } :: e.clash,
2014    e.clash <Compare-Subexprs (e.fail) (e.conds e.l-cond e.r-cond) e.rest>;
2015  (e.conds);
2016};
2017
2018Compare-Terms-Left (e.fail) (e.pos) (e.Re) e.Pe, {
2019  e.Pe : t.Pt e.rest, {
2020    <Get-Known-Length t.Pt> : e.len (), {
2021      \{
2022        <Get-Var Instantiated? t.Pt> : True =
2023          {
2024            <Get-Var Flat? t.Pt> : True = FLAT-EQ;
2025            EQ;
2026          };
2027        t.Pt : \{
2028          (REF e) = t.Pt;
2029          (STATIC e) = <Get-Static t.Pt>;
2030        } :: e.Pt =
2031          {
2032            <Flat-Const? e.Pt> = FLAT-EQ;
2033            EQ;
2034          };
2035        <Var? t.Pt> =
2036          <Set-Var (Value (e.Re) (e.pos) (e.len)) t.Pt>,
2037          $fail;
2038      } :: s.eq =
2039        (IF ((NOT (EQ (e.Re) (e.pos) (e.len) (t.Pt) (0) (e.len)))) e.fail);
2040      /*empty*/;
2041    } :: e.cond =
2042      e.cond <Compare-Terms-Left (e.fail) (e.pos e.len) (e.Re) e.rest>;
2043    (e.Pe);
2044  };
2045  ();
2046};
2047
2048Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = (e.Pe);
2049
2050
2051
2052Comp-Cycle e.clashes =
2053  e.clashes : e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2 =
2054  e.Re : t.var,
2055  s.dir : {
2056    LEFT =
2057      e.Pe : t.var-e1 e.rest,
2058      <Gener-Vars ((VAR)) "lsplit" e.Re> : t.var-e2,
2059      <Set-Var (Instantiated? True) t.var-e1>,
2060      <Set-Var (Instantiated? True) t.var-e2>,
2061      t.var t.var-e1 t.var-e2
2062      e1 (<Gener-Label "clash"> &New-Clash-Tags (t.var-e2) (s.dir e.rest)) e2;
2063  };
2064
2065
2066
2067Compare-Subexpr e.clashes =
2068  e.clashes () () () Old $iter e.clashes : {
2069    (e.t1 Compare e.t2 (e.Re) (s.dir e.Pe)) e.rest,
2070      e.Re : (VAR t.name),
2071      <?? t.name Instantiated> : True =
2072      {
2073        e.t1 e.t2 : e Without-object-symbols e =
2074          /*empty*/ (e.t2) (e.Re) (e.Pe);
2075        <Get-Static-Exprs e.Re> :: e.Re (e.Re-decls),
2076          <Get-Static-Exprs e.Pe> :: e.Pe (e.Pe-decls) =
2077          e.Re-decls e.Pe-decls (e.t2 Without-object-symbols) (e.Re) (e.Pe);
2078      } :: e.new-asserts (e.t2) (e.Re) (e.Pe),
2079      e.Pe () () Continue $iter {
2080        e.format : t.Ft e.Fe,
2081          <Length-of e.left> :: e.pos,
2082          <Length-of t.Ft> :: e.len,
2083          <Length-of e.Fe> :: e.right-pos,
2084          {
2085            \{
2086              <?? t.name Left-compare> :
2087                e (t.Ft Left (0) (e.pos) e.len) e;
2088              <?? t.name Right-compare> :
2089                e (t.Ft Left (0) (e.right-pos) e.len) e;
2090            } =
2091               /*empty*/ Continue;
2092            <Compare-Ft t.Ft> : {
2093              /*empty*/ s.stop??? = /*empty*/ s.stop???;
2094              e.compare s.eq =
2095//                <WriteLN Compare e.compare s.eq>,
2096                t.Ft : (VAR t.Ft-name),
2097                <Set-Var t.name (Left-compare) (<?? t.name Left-compare>
2098                  (t.Ft Left (0) (e.pos) e.len))>,
2099                <Set-Var t.Ft-name (Left-compare)
2100                  (<?? t.Ft-name Left-compare>
2101                  (e.Re Left (e.pos) (0) e.len))>,
2102                e.compare : {
2103                  Empty = /*empty*/ Continue;
2104                  Instantiated =
2105                    (t.Ft) (0) (e.len) :: e.sub1,
2106                    (e.Re) (e.pos) (e.len) :: e.sub2,
2107                    { s.eq : EQ = 0; 1; } :: s.R,
2108                    (Used t.Ft e.Re)
2109                    (s.eq <Middle 0 s.R e.sub1> e.sub2) Continue;
2110//                    (s.eq ((FIRST t.Ft)) ((LAST t.Ft))
2111//                      ((FIRST e.Re) e.pos) ((FIRST e.Re) e.pos e.len)
2112//                    ) Continue;
2113                  (t.var s.dir1 (e.pos1) (0) e.len), s.dir1 : {
2114                    Left =
2115                      (t.var) (e.pos1) (e.len) :: e.sub1,
2116                      (e.Re) (e.pos) (e.len) :: e.sub2,
2117                      { s.eq : EQ = 0; 1; } :: s.R,
2118                      (Used t.var e.Re)
2119                      (s.eq <Middle 0 s.R e.sub1> e.sub2) Continue;
2120//                      (s.eq ((FIRST t.var) e.pos1)
2121//                        ((FIRST t.var) e.pos1 e.len)
2122//                        ((FIRST e.Re) e.pos)
2123//                        ((FIRST e.Re) e.pos e.len)
2124//                      ) Continue;
2125                    Right =
2126                      (t.var)
2127                      ((INFIX "-" ((LENGTH t.var)) (e.pos1) (e.len)))
2128                      (e.len) :: e.sub1,
2129                      (e.Re) (e.pos) (e.len) :: e.sub2,
2130                      { s.eq : EQ = 0; 1; } :: s.R,
2131                      (Used t.var e.Re)
2132                      (s.eq <Middle 0 s.R e.sub1> e.sub2) Continue;
2133//                      (s.eq
2134//                        ((INFIX "-"
2135//                          ((LAST t.var)) (e.pos1) (e.len))
2136//                        )
2137//                        ((INFIX "-" ((LAST t.var)) (e.pos1)))
2138//                        ((FIRST e.Re) e.pos)
2139//                        ((FIRST e.Re) e.pos e.len)
2140//                      ) Continue;
2141//                    <Set-Var t.name Left-compare
2142//                      <?? t.name Left-compare>
2143//                      (t.name1 s.dir (e.pos1) (e.pos) e.len)
2144                  };
2145                };
2146            };
2147          } :: e.Ft-cond s.stop? =
2148          e.Fe (e.left t.Ft) (e.new-cond e.Ft-cond) s.stop?;
2149      } :: e.format (e.left) (e.new-cond) s.stop?,
2150      \{
2151        e.format : /*empty*/ =
2152          e.rest (e.cond e.new-cond) (e.new-asserts)
2153          (e.new-clashes (e.t1 e.t2 (e.Re) (s.dir e.Pe))) New;
2154        s.stop? : Stop = e.format () (e.new-cond) Continue $iter {
2155          e.format : e.Fe t.Ft,
2156            <Length-of e.right> :: e.pos,
2157            <Length-of t.Ft> :: e.len,
2158            {
2159              <?? t.name Right-compare> : e (t.Ft Left (0) (e.pos) e.len) e =
2160                /*empty*/ Continue;
2161              <Compare-Ft t.Ft> : {
2162                /*empty*/ s.stop??? = /*empty*/ s.stop???;
2163                e.compare s.eq =
2164                  t.Ft : (VAR t.Ft-name),
2165                  <Set-Var t.name (Right-compare)
2166                    (<?? t.name Right-compare>
2167                    (t.Ft Left (0) (e.pos) e.len))>,
2168                  <Set-Var t.Ft-name (Left-compare)
2169                    (<?? t.Ft-name Left-compare>
2170                    (e.Re Right (e.pos) (0) e.len))>,
2171                  e.compare : {
2172                    Empty = /*empty*/ Continue;
2173                    Instantiated =
2174                      (t.Ft) (0) (e.len) :: e.sub1,
2175                      (e.Re)
2176                      ((INFIX "-" ((LENGTH e.Re)) (e.pos) (e.len)))
2177                      (e.len) :: e.sub2,
2178                      { s.eq : EQ = 0; 1; } :: s.R,
2179                      (Used t.Ft e.Re)
2180                      (s.eq <Middle 0 s.R e.sub1> e.sub2) Continue;
2181//                      (s.eq ((FIRST t.Ft)) ((LAST t.Ft))
2182//                        ((INFIX "-" ((LAST e.Re)) (e.pos) (e.len)))
2183//                        ((INFIX "-" ((LAST e.Re)) (e.pos)))
2184//                      ) Continue;
2185                    (t.var s.dir1 (e.pos1) (0) e.len), s.dir1 : {
2186                      Left =
2187                        (t.var) (e.pos1) (e.len) :: e.sub1,
2188                        (e.Re)
2189                        ((INFIX "-"
2190                          ((LENGTH e.Re)) (e.pos) (e.len)
2191                        )) (e.len) :: e.sub2,
2192                        { s.eq : EQ = 0; 1; } :: s.R,
2193                        (Used t.var e.Re)
2194                        (s.eq <Middle 0 s.R e.sub1> e.sub2)
2195                        Continue;
2196//                        (s.eq ((FIRST t.var) e.pos1)
2197//                          ((FIRST t.var) e.pos1 e.len)
2198//                          ((INFIX "-"
2199//                            ((LAST e.Re)) (e.pos) (e.len)
2200//                          ))
2201//                          ((INFIX "-" ((LAST e.Re)) (e.pos)))
2202//                        ) Continue;
2203                      Right =
2204                        (t.var)
2205                        ((INFIX "-"
2206                          ((LENGTH t.var)) (e.pos1) (e.len)
2207                        )) (e.len) :: e.sub1,
2208                        (e.Re)
2209                        ((INFIX "-"
2210                          ((LENGTH e.Re)) (e.pos) (e.len)
2211                        )) (e.len) :: e.sub2,
2212                        { s.eq : EQ = 0; 1; } :: s.R,
2213                        (Used t.var e.Re)
2214                        (s.eq <Middle 0 s.R e.sub1> e.sub2)
2215                        Continue;
2216//                        (s.eq
2217//                          ((INFIX "-"
2218//                            ((LAST t.var)) (e.pos1) (e.len)
2219//                          ))
2220//                          ((INFIX "-" ((LAST t.var)) (e.pos1)))
2221//                          ((INFIX "-"
2222//                            ((LAST e.Re)) (e.pos) (e.len)
2223//                          ))
2224//                          ((INFIX "-" ((LAST e.Re)) (e.pos)))
2225//                        ) Continue;
2226                    };
2227                  };
2228              };
2229            } :: e.Ft-cond s.stop? =
2230            e.Fe (t.Ft e.right) (e.new-cond e.Ft-cond) s.stop?;
2231        } :: e.format (e.right) (e.new-cond) s.stop?,
2232          s.stop? : Stop =
2233          e.rest (e.cond e.new-cond) (e.new-asserts)
2234          (e.new-clashes (e.t1 Compare e.t2 (e.Re) (s.dir e.Pe))) s.new?;
2235      };
2236    t.clash e.rest = e.rest (e.cond) (e.asserts) (e.new-clashes t.clash) s.new?;
2237  } :: e.clashes (e.cond) (e.asserts) (e.new-clashes) s.new?,
2238//  <WriteLN Compare-Subexpr e.clashes (e.cond) (e.asserts) (e.new-clashes) s.new?>,
2239  e.clashes : /*empty*/ =
2240  e.cond (e.asserts) (e.new-clashes) s.new?;
2241
2242Compare-Ft {
2243  s.ObjectSymbol =
2244    <PrintLN "Compare-Ft: can't compare object symbols!">, $fail;
2245  (PAREN e.expr) =
2246    /*empty*/ Continue;
2247  (VAR t.name), {
2248    <Hard-Exp? (VAR t.name)>, {
2249      <?? t.name Instantiated> : True = Instantiated;
2250      <?? t.name Left-compare> : {
2251        t.compare e = t.compare;
2252        /*empty*/ = Empty;
2253      };
2254    } :: e.compare,
2255      {
2256        <?? t.name Flat> : True,
2257          <?? t.name Length> : 1 = FLAT-EQ;
2258        EQ;
2259      } :: s.eq =
2260      e.compare s.eq;
2261    /*empty*/ Stop;
2262  };
2263};
2264
2265Get-Source e.clashes =
2266  e.clashes : e1 (e.tags (e.Re) (s.dir e.Pe)) e2,
2267  \{
2268    /*
2269     * If source is an instantiated variable then go to the next clash.
2270     */
2271    e.Re : (VAR t.name),
2272      <?? t.name Instantiated> : True = $fail;
2273    /*
2274     * If in source there is unknown variable then we can't compute it, so
2275     * go to the next clash.
2276     */
2277    e.Re $iter e.Re : {               
2278      (VAR t.name) e.rest =           
2279        \{                   
2280          <?? t.name Instantiated> : True; 
2281          <?? t.name Left-compare> : v;   
2282        }, e.rest;               
2283      t e.rest = e.rest;             
2284    } :: e.Re,                   
2285      e.Re : /*empty*/;             
2286  } =
2287//  <WriteLN Get-Source (e.tags (e.Re) (s.dir e.Pe))>,
2288  {
2289    e.Re : /*empty*/ =
2290      <Store-Vars (EVAR ("empty" 0))> : t.empty,
2291      <Set-Var ("empty") (Instantiated) (True)>,
2292      () () (e.tags (t.empty) (s.dir e.Pe));
2293    e.Re : (VAR t.name) =
2294      (e.Re) () (e.tags (e.Re) (s.dir e.Pe));
2295    {
2296      e.tags : e Without-object-symbols e =
2297        /*empty*/ (e.tags (e.Re) (s.dir e.Pe));
2298      <Get-Static-Exprs e.Re> :: e.Re (e.Re-decls),
2299        <Get-Static-Exprs e.Pe> :: e.Pe (e.Pe-decls) =
2300        e.Re-decls e.Pe-decls (e.tags Without-object-symbols (e.Re) (s.dir e.Pe));
2301    } :: e.asserts (e.tags (e.Re) (s.dir e.Pe)), {
2302      e.Re : (VAR t.name) =
2303        () (e.asserts) (e.tags (e.Re) (s.dir e.Pe));
2304      <Compose-Expr e.Re> :: e.compose (e.not-inst) s.flat?,
2305        <Gener-Label "compose"> :: t.name,
2306        <Declare-Vars "Expr" (VAR t.name)> :: e.decl,
2307        <Instantiate-Vars (VAR t.name)>,
2308        {
2309          s.flat? : 0 = <Set-Var t.name (Flat) (True)>;;
2310        },
2311        <Set-Var t.name (Length) (<Length-of e.Re>)>,
2312        <Set-Var t.name (Format) (<Format-Exp e.Re>)> =
2313        (e.not-inst) (e.asserts e.decl (ASSIGN (VAR t.name) e.compose))
2314        (e.tags ((VAR t.name)) (s.dir e.Pe));
2315    };
2316  } :: (e.not-inst) (e.decl) t.clash,
2317  (Assert <Get-Subexprs e.not-inst> e.decl) (e1 t.clash e2);
2318
2319Compose-Expr e.Re =
2320  e.Re () () 0 $iter {
2321    e.Re : t.Rt e.rest, t.Rt : {
2322      s.ObjectSymbol =
2323        <PrintLN "Compose-Expr: can't deal with object symbols!">, $fail;
2324      (PAREN e.expr) =
2325        <Compose-Expr e.expr> :: e.expr (e.new-not-inst) s,
2326        (PAREN e.expr) (e.new-not-inst) 1;
2327      (VAR t.name) =
2328        {
2329          <?? t.name Instantiated> : True = /*empty*/;
2330          t.Rt;
2331        } :: e.new-not-inst,
2332        {
2333          <?? t.name Flat> : True = 0;
2334          1;
2335        } :: s.new-flat?,
2336        (Used t.Rt) t.Rt (e.new-not-inst) s.new-flat?;
2337      t = t.Rt () 0; // STUB!
2338    } :: e.new-compose (e.new-not-inst) s.new-flat? =
2339      e.rest (e.compose e.new-compose) (e.not-inst e.new-not-inst)
2340      <"+" s.flat? s.new-flat?>;
2341  } :: e.Re (e.compose) (e.not-inst) s.flat?,
2342  e.Re : /*empty*/ =
2343  e.compose (e.not-inst) s.flat?;
2344
2345Get-Subexprs e.vars =
2346//  <WriteLN Get-Subexprs e.vars>,
2347  e.vars () $iter {
2348    e.vars : (VAR t.name) e.rest,
2349      # \{ <?? t.name Instantiated> : True; },
2350      <?? t.name Left-compare> : (t.var s.dir (e.pos) (0) e.len) e =
2351      <Instantiate-Vars (VAR t.name)>,
2352      <Declare-Vars "Expr" (VAR t.name)> : e,
2353      {
2354        s.dir : Right =
2355          (INFIX "-" (<Length-of t.var>) (e.pos e.len));
2356        e.pos;
2357      } :: e.pos,
2358      e.rest (e.decls (Used t.var) (SUBEXPR (VAR t.name) t.var (e.pos) (e.len)));
2359    // STUB:
2360    e.vars : t e.rest = e.rest (e.decls);
2361  } :: e.vars (e.decls),
2362  e.vars : /*empty*/ =
2363  e.decls;
2364
2365Comp-Cyclic e.clashes =
2366  <WriteLN ??? e.clashes>,
2367  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 =
2368  e.Re : (VAR (e.QualifiedName)),
2369  <Split-Hard-Left e.Pe> :: e.left-hard,
2370  <Split-Hard-Right e.Pe> :: e.right-hard,
2371  e.Pe : e.left-hard e.Cycle e.right-hard,
2372  {
2373    e.left-hard e.right-hard : /*empty*/ = /*empty*/ (e.QualifiedName) ();
2374    <Gener-Label "ref" e.QualifiedName> :: t.name,
2375      t.name : (e.CycleName),
2376      <Declare-Vars "Expr" (VAR t.name)> : e,
2377      <Instantiate-Vars (VAR t.name)>,
2378      <Set-Var t.name (Format) (<Format-Exp e.Cycle>)>,
2379      (INFIX "-" (<Length-of e.Re>) (<Length-of e.right-hard>)) :: e.len,
2380      (Used e.Re)
2381      (SUBEXPR (VAR t.name) e.Re (<Length-of e.left-hard>) (e.len)) :: e.decl,
2382      <Set-Var t.name (Left-compare)
2383        ((e.Re Left (<Length-of e.left-hard>) (0) <Length-of (VAR t.name)>))>,
2384      <Set-Var (e.QualifiedName) (Left-compare) ((
2385        (VAR t.name) Left (0) (<Length-of e.left-hard>) <Length-of (VAR t.name)>
2386      ))> =
2387      (e.t1 Checked-length e.t2 (e.Re) (s.dir e.left-hard (VAR t.name) e.right-hard))
2388      (e.CycleName) (e.decl);
2389  } :: e.old-clash (e.CycleName) (e.decl),
2390  (VAR (e.CycleName)) :: t.var,
2391  <Gener-Label L "For" "Break"> :: t.break-label,
2392  <Gener-Label L "For" "Cont"> :: t.cont-label,
2393  s.dir : {
2394    LEFT =
2395      <WriteLN XXXXX e.Cycle>,
2396      e.Cycle : t.var-e1 e.rest,
2397//!                     t.var-e1 : (VAR (e.SplitName)),
2398      t.var-e1 : (s (e.SplitName)), //STUB!
2399      {
2400//        e.rest : t.var-e2 = t.var-e2;
2401        (VAR <Gener-Label "lsplit" e.CycleName>);
2402      } :: t.var-e2,
2403      <Declare-Vars "Expr" t.var-e2> : e,
2404//!                     <Instantiate-Vars t.var-e1 t.var-e2>
2405      (Assert
2406        e.decl
2407        (LSPLIT t.var ((VAR ("min" e.SplitName))) t.var-e1 t.var-e2)
2408      )
2409      (Cond LABEL (t.break-label))
2410      (Cond FOR (t.cont-label) () ((INC-ITER t.var)))
2411      (Fail (BREAK t.break-label))
2412      (Clear-Restricted)
2413      (<Update-Ties t.var-e2 <Update-Ties t.var-e1 e1>>
2414        e.old-clash
2415        (<Gener-Label "clash"> &New-Clash-Tags (t.var-e2) (s.dir e.rest))
2416      <Update-Ties t.var-e2 <Update-Ties t.var-e1 e2>>)
2417      ((CONTINUE t.cont-label));
2418    RIGHT =
2419      e.Cycle : e.rest t.var-e2,
2420      t.var-e2 : (VAR (e.SplitName)),
2421      {
2422//        e.rest : t.var-e2 = t.var-e2;
2423        (VAR <Gener-Label "lsplit" e.CycleName>);
2424      } :: t.var-e1,
2425      <Declare-Vars "Expr" t.var-e1> : e,
2426      <Instantiate-Vars t.var-e1 t.var-e2>
2427      (Assert
2428        e.decl
2429        (RSPLIT t.var ((VAR ("min" e.SplitName))) t.var-e1 t.var-e2)
2430      )
2431      (Cond LABEL (t.break-label))
2432      (Cond FOR (t.cont-label) () ((INC-ITER t.var)))
2433      (Fail (BREAK t.break-label))
2434      (Clear-Restricted)
2435      (<Update-Ties t.var-e2 <Update-Ties t.var-e1 e1>>
2436        e.old-clash
2437        (<Gener-Label "clash"> &New-Clash-Tags (t.var-e1) (s.dir e.rest))
2438      <Update-Ties t.var-e2 <Update-Ties t.var-e1 e2>>)
2439      ((CONTINUE t.cont-label));
2440  };
2441
2442Split-Hard-Left e.expr =
2443  e.expr () $iter {
2444    e.expr : t.Pt e.rest, {
2445      <Hard-Exp? t.Pt> = e.rest (e.hard t.Pt);
2446      (e.hard);
2447    };
2448  } :: e.expr (e.hard),
2449  e.expr : /*empty*/ =
2450  e.hard;
2451
2452Split-Hard-Right e.expr =
2453  e.expr () $iter {
2454    e.expr : e.some t.Pt, {
2455      <Hard-Exp? t.Pt> = e.some (t.Pt e.hard);
2456      (e.hard);
2457    };
2458  } :: e.expr (e.hard),
2459  e.expr : /*empty*/ =
2460  e.hard;
2461
2462Gener-Label e.QualifiedName =
2463  {
2464    <Lookup &Labels e.QualifiedName> : s.num,
2465      <"+" s.num 1>;
2466    1;
2467  } :: s.num,
2468  <Bind &Labels (e.QualifiedName) (s.num)>,
2469  (e.QualifiedName s.num);
2470
2471Add-To-Label (e.label) e.name = <Gener-Label e.label "_" e.name>;
2472
2473Get-Static-Exprs e.Re =
2474  e.Re () () () $iter {
2475    e.Re : t.Rt e.rest, t.Rt : {
2476      s.ObjectSymbol, {
2477        <Char? t.Rt> =
2478          e.rest (e.new-Re) (e.decls) (e.expr t.Rt);
2479        <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
2480          {
2481            <Int? t.Rt> = "int";
2482            <Word? t.Rt> = "word";
2483          } :: s.prefix,
2484          <Get-Static-Var s.prefix t.Rt> :: e.Rt-var (e.Rt-decl) =
2485          e.rest (e.new-Re e.expr-var e.Rt-var)
2486          (e.decls e.expr-decl e.Rt-decl) ();
2487      };
2488      (PAREN e.paren-Re) =
2489        <Get-Static-Exprs e.paren-Re> :: e.new-paren-Re (e.paren-decls),
2490        <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
2491        e.rest (e.new-Re e.expr-var (PAREN e.new-paren-Re))
2492        (e.decls e.expr-decl e.paren-decls) ();
2493      t.var =
2494        <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
2495        e.rest (e.new-Re e.expr-var t.var) (e.decls e.expr-decl) ();
2496    };
2497  } :: e.Re (e.new-Re) (e.decls) (e.expr),
2498//  <WriteLN Get-Static-Exprs e.Re>,
2499  e.Re : /*empty*/ =
2500  <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
2501  e.new-Re e.expr-var (e.decls e.expr-decl);
2502
2503Get-Static-Var s.prefix e.expr, {
2504  e.expr : /*empty*/ = /*empty*/ ();
2505  {
2506    <Lookup &Static-Exprs s.prefix e.expr> : t.var = t.var ();
2507    ("const" s.prefix e.expr) :: t.name,
2508      <Bind &Static-Exprs (s.prefix e.expr) ((VAR t.name))>,
2509      <Declare-Vars "Expr" (VAR t.name)> : e,
2510      <Instantiate-Vars (VAR t.name)>,
2511      <Set-Var t.name (Flat) (True)>,
2512      <Length e.expr> :: s.len,
2513      <Set-Var t.name (Length) (s.len)>,
2514      <Set-Var t.name (Min) (s.len)>,
2515      <Set-Var t.name (Max) (s.len)>,
2516      <Set-Var t.name (Format) (e.expr)> =
2517      (VAR t.name) ((EXPR (VAR t.name) e.expr));
2518  };
2519};
2520
2521
2522
2523$func Ref-Len t.name = e.length;
2524
2525/*
2526 * Из верхнего уровня выражения изымаются все переменные, длина которых не
2527 * может быть посчитана (она неизвестна из формата, и переменная ещё не
2528 * получила значение в run-time).  Список этих переменных возвращается вторым
2529 * параметром.  Первым параметром возвращается длина оставшегося после их
2530 * изъятия выражения.
2531 */
2532Get-Known-Length e.Re =
2533  e.Re (/*e.length*/) (/*e.unknown-vars*/) $iter {
2534    e.Re : t.Rt e.rest, t.Rt : {
2535      s.ObjectSymbol = 1 ();    // Может появиться из константы.
2536      (PAREN e) = 1 ();
2537      (REF t.name) = <Ref-Len t.name> ();
2538      (STATIC t.name) = <Get-Known-Length <Get-Static t.Rt>>;
2539      t, <Var? t.Rt>, {
2540        <Get-Var Length t.Rt> : v.len = v.len ();
2541        <Get-Var Instantiated? t.Rt> : True = (LENGTH t.Rt) ();
2542        /*empty*/ (t.Rt);
2543      };
2544    } :: e.len (e.var),
2545      e.rest (e.length e.len) (e.unknown-vars e.var);
2546  } :: e.Re (e.length) (e.unknown-vars),
2547  e.Re : /*empty*/ =
2548  {
2549    e.length : /*empty*/ = 0 (e.unknown-vars);
2550    e.length (e.unknown-vars);
2551  };
2552
2553Length-of {
2554  /*empty*/ = 0;
2555  e.Re =
2556    e.Re () $iter {
2557      e.Re : t.Rt e.rest, t.Rt : {
2558        s.ObjectSymbol = 1;     // Может появиться из константы.
2559        (PAREN e) = 1;
2560        (REF t.name) = <Ref-Len t.name>;
2561        (STATIC t.name) = <Length-of <Get-Static t.Rt>>;
2562        t, <Var? t.Rt>, {
2563          <Get-Var Length t.Rt> : v.len = v.len;
2564          (LENGTH t.Rt);
2565        };
2566      } :: e.new-len,
2567      e.rest (e.Length e.new-len);
2568    } :: e.Re (e.Length),
2569    e.Re : /*empty*/ =
2570    e.Length;
2571};
2572
2573Ref-Len t.name = {
2574  <Lookup &Const-Len t.name>;
2575  <Length-of <Middle 3 0 <Lookup &Const t.name>>> :: e.len =
2576    <Bind &Const-Len (t.name) (e.len)>,
2577    e.len;
2578  1;
2579};
2580
2581Flat-Const? {
2582  (PAREN e) e = $fail;
2583  (REF t.name) e.rest, {
2584    <Middle 3 0 <Lookup &Const t.name>> :: e.const =
2585      <Flat-Const? e.const> <Flat-Const? e.rest>;
2586    <Flat-Const? e.rest>;
2587  };
2588  s.ObjectSymbol e.rest = <Flat-Const? e.rest>;
2589  /*empty*/;
2590};
2591
2592/*
2593 * Ends good if lengths of all variables in the upper level of e.expr can be
2594 * calculated.
2595 */
2596Hard-Exp? e.expr =
2597  e.expr $iter {
2598    e.expr : t.first e.rest =
2599    {
2600      <Var? t.first>, {
2601        <Get-Var Instantiated? t.first> : True;
2602        <Get-Var Length t.first> : v;
2603        = $fail;
2604      };;
2605    },
2606      e.rest;
2607  } :: e.expr,
2608  e.expr : /*empty*/;
2609
2610/*
2611 * Returns those parts of e.expr which lengthes are known. Also returns a list
2612 * of variables with unknown lengthes.
2613 */
2614Unknown-Vars e.expr =
2615  e.expr () () $iter {
2616    e.expr : t.first e.rest, {
2617      t.first : (VAR t.name), {
2618        <?? t.name Instantiated> : True =
2619          e.new-expr t.first (e.unknown);
2620        <?? t.name Max> :: e.max, <?? t.name Min> : e.max =
2621          e.new-expr t.first (e.unknown);
2622        e.new-expr (e.unknown t.first);
2623      };
2624      e.new-expr t.first (e.unknown);
2625    } :: e.new-expr (e.unknown) =
2626      e.rest (e.new-expr) (e.unknown);
2627  } :: e.expr (e.new-expr) (e.unknown),
2628  e.expr : /*empty*/ =
2629  e.new-expr (e.unknown);
2630
2631
2632
2633Print-Error s.WE e.Descrip t.Pragma =
2634  <? &Error-Counter> : s.n,
2635  <Store &Error-Counter <"+" s.n 1>>,
2636  <Print-Pragma &StdErr t.Pragma>,
2637  <Print! &StdErr " " s.WE " ">,
2638  s.WE e.Descrip : {
2639    Error! Re = <PrintLN! &StdErr "Wrong format of result expression">;
2640    Error! Call = <PrintLN! &StdErr "Wrong argument format in function call">;
2641    Error! Pattern = <PrintLN! &StdErr "Wrong format of pattern expression">;
2642    Warning! Pattern = <PrintLN! &StdErr "Clash can't be solved">;
2643    Error! Var-Re t.var =
2644      <PrintLN! &StdErr "Unknown variable '"
2645                <AS-To-Ref t.var> "' in result expression">;
2646    Error! Var-Hard t.var =
2647      <PrintLN! &StdErr "Repeated occurence of the variable '"
2648                <AS-To-Ref t.var> "' in hard expression">;
2649    Error! Var-Type t.var s.type =
2650      <PrintLN! &StdErr "Incorrect type '" <AS-To-Ref s.type>
2651                "' of the variable '" <AS-To-Ref t.var> "'">;
2652    Error! Cut = <PrintLN! &StdErr "'\\\\!' without corresponding '\\\\?'">;
2653  };
2654
2655Print-Pragma s.channel (PRAGMA e.pragmas),
2656  e.pragmas : {
2657    e (FILE e.file-name) e, <Print! s.channel e.file-name>, $fail;
2658    e (LINE s.line s.col) e, <Print! s.channel (s.line ", " s.col)>, $fail;
2659    e = <Print! s.channel ":">;
2660  };
2661
2662AS-To-Ref {
2663  SVAR = 's';
2664  TVAR = 't';
2665  VVAR = 'v';
2666  EVAR = 'e';
2667  (s.tag t (e.name)) = <AS-To-Ref s.tag> '.' <To-Chars e.name>;
2668};
2669
2670Lookup-Func t.Fname, \{
2671  <Lookup &Fun t.Fname>;
2672  <Lookup &Fun? t.Fname>;
2673} : s.linkage s.tag t.pragma (e.Fin) (e.Fout) =
2674  s.linkage s.tag t.pragma (e.Fin) (e.Fout);
2675
Note: See TracBrowser for help on using the repository browser.