// $Source$
// $Revision$
// $Date$

$use "rfpc";
$use "rfp_err";
$use "rfp_list";
$use "rfp_helper";
$use "rfp_check";
$use "rfp_as2as";
$use "rfp_format";
$use "rfp_vars";
$use "rfp_const";
$use "rfp_clashes";

$use StdIO;
$use Table;
$use Box;
$use Arithm;
$use Access;
$use Compare;
$use Convert;
$use Class;
$use Apply;
$use Dos;

/*
 * Functions for distinguishing flat symbols from not flat.
 */
$const Flat-Symbols = &Char?- &Int?-;

/*
 * Table for storing object names.
 */
$table Objects;

/*
 * Table for storing referenced functions.
 */
$table Ref-To-Funcs;

/*
 * Box for storing function out format
 */
$box Out-Format;

/*
 * Box for storing names for function input variables
 */
$box Arg-Vars;

/*
 * Box for storing names for function result variables
 */
$box Res-Vars;

/*
 * Following table is used by Gener-Label function for obtaining unical (for
 * certain function) label name.
 * e.Key ::= e.QualifiedName      (parameter given to Gener-Label)
 * e.Val ::= [Int]          (last index used with such e.QualifiedName)
 */
$table Labels;

//$box Var-Stack;
$table Vars-Tab;

$box Greater-Ineqs;
$box Less-Ineqs;

$table Static-Exprs;

$func Compile (e.targets) (e.headers) e.Items = e.Compiled-Items (INTERFACE e.headers);

$func Print-Pragma s.channel t.Pragma = ;

$func AS-To-Ref e.AS-Expr = e.Refal-Expr;

$func Length-of e.Re = e.length;

$func? Flat-Const? e.const = ;

$func? Hard-Exp? e.expr = ;

$func Comp-Func-Stubs = e.asail-funcs;

$func Comp-Func s.tag t.name e.params-and-body = e.compiled-func;

$func Set-Drops (e.declared-exprs) e.comp-func = (e.declared-exprs) e.result-func;

$func Comp-Sentence e.Sentence = e.asail-sentence;

$func Save-Snt-State = ;

$func Recall-Snt-State = ;

$func Pop-Snt-State = ;

$func Extract-Calls e.Re = (e.last-Re) e.calls;

$func Get-Clash-Sequence (e.last-Re) e.Snt = (e.clashes) e.rest-of-the-Sentence;

$func? Without-Calls? e.Re = ;

//$func Old-Vars e.expr = e.expr;

//$func Find-Known-Lengths e.clashes = (e.known-len-clashes) e.clashes;

//$func? Known-Vars? e.vars = ;

$func Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence = e.asail-sentence;

$func? Find-Var-Length e.clashes = e.cond (e.clashes);

$func Update-Ties t.var e.clashes = e.clashes;

$func Known-Length-of e.expr = e.known-length (e.unknown-vars);

$func? Cyclic-Restrictions e.clashes = e.cond (e.clashes);

$func Cyclic-Min t.var = e.min;

$func? Cyclic-Max t.var = e.max;

$func? Get-Source e.clashes = e.cond (e.clashes);

$func Compose-Expr e.expr = e.compose (e.not-instantiated-vars) s.flat?;

$func? Comp-Cyclic e.clashes = e.cond (e.clashes) (e.fail);

$func Get-Subexprs e.vars = e.asail-decls;

$func Unknown-Vars e.expr = e.known-expr (e.unknown-vars);

$func Split-Hard-Left e.expr = e.hard;

$func Split-Hard-Right e.expr = e.hard;

$func Gener-Label e.QualifiedName = t.label;

$func Add-To-Label t.label e.name = t.label;

$func Comp-Calls e.Re = e.calls;

$func Comp-Static-Exprs e.Reult-exprs = e.Result-exprs;

$func Comp-Assigns e.assignments = e.asail-assignments;

$func Comp-Format (e.last-Re) e.He = e.assignments;

$func Get-Static-Exprs e.expr = e.expr (e.decls);

$func Get-Static-Var e.expr = e.var (e.decl);



************ Get AS-Items and targets, and pass it to Compile ************

/*
 * Ящик для объявлений статических функций, констант и объектов.  Все они
 * выписываются в самом начале тела модуля.
 */
$box Declarations;

RFP-Compile e.Items =
  { <Lookup &RFP-Options ITEMS>;; } :: e.targets,
  <Store &Declarations /*empty*/>,
  <Init-Consts>,
  <Compile (e.targets) () e.Items> :: e.Items t.Interface,
  t.Interface (MODULE <? &Declarations> <Comp-Consts> e.Items);



****************** Choose needed items and compile them ******************

Compile (e.targets) (e.headers) e.Items, {
  e.Items : e t.item e.rest,
    {
      e.targets : v =
        e.targets : e t.name e,
        t.item : (t t t t.name e);;
    },
    t.item : {
      (IMPORT e) = () /*empty*/;
      (s.link s.tag t.pragma t.name (e.in) (e.out) e.body), FUNC FUNC? : e s.tag e =
        { 
          s.link : EXPORT = (DECL-FUNC EXPORT t.name);
          <Put &Declarations (DECL-FUNC LOCAL t.name)> = /*empty*/;
        } :: e.decl,
        {
          e.body : (BRANCH t.p e.branch) =
            <Comp-Func s.tag t.name <Del-Pragmas (e.in) (e.out) e.branch>>;;
        } :: e.comp-func,
        (e.decl) e.comp-func;
      (s.link CONST t.pragma t.name e.expr) =
        (CONSTEXPR s.link t.name (e.expr) e.expr) :: t.const,
        {
          s.link : EXPORT = (t.const) /*empty*/;
          <Put &Declarations t.const> = () /*empty*/;
        };
      (EXPORT s.tag t.pragma t.name) = ((DECL-OBJ EXPORT s.tag t.name)) /*empty*/;
      (LOCAL  s.tag t.pragma t.name) =
        <Put &Declarations (DECL-OBJ LOCAL s.tag t.name)>,
        () /*empty*/;
    } :: (e.decl) e.item =
    e.item <Compile (e.targets) (e.headers e.decl) e.rest>;
  /*<Comp-Func-Stubs>*/ (INTERFACE e.headers);
};

/*
 * For each referenced function generate a stub one with format e = e.
 */
Comp-Func-Stubs =
  <Domain &Ref-To-Funcs> () $iter {
    e.funcs : ((e.QualifiedName)) e.rest,
      (e.QualifiedName 0) :: t.Fname,
//      <Bind &Ref-To-Funcs ((e.QualifiedName)) (t.Fname)>,
//      {
//        <In-Table? &Fun? (e.QualifiedName)> =
//          <Bind &Back-Funcs (t.Fname) ()>;;
//      },
//      <Bind &Fin (t.Fname) ((EVAR))>,
//      <Bind &Fout (t.Fname) ((EVAR))>,
      <Lookup-Func (e.QualifiedName)> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
      <Gener-Vars (e.Fin) "stub"> :: e.He,
      <Comp-Func s.tag t.Fname ((EVAR ("arg" 1))) ((EVAR ("res" 1)))
        (LEFT e.He) (RESULT (CALL (e.QualifiedName) e.He))
      > :: e.asail,
      e.rest (e.asail-funcs e.asail);
  } :: e.funcs (e.asail-funcs),
  e.funcs : /*empty*/ =
  // Here is place to define expressions - references to stub functions.
  // Use &Ref-To-Funcs for that.
  e.asail-funcs;

Comp-Func s.tag t.name (e.in) (e.out) e.Sentence =
  <RFP-Clear-Table &Labels>,
  <RFP-Clear-Table &Static-Exprs>,
  <Store &Greater-Ineqs /*empty*/>,
  <Store &Less-Ineqs /*empty*/>,
//!	<RFP-Clear-Table &Vars-Tab>,
  <Init-Vars>,
//!	<Ref-To-Var e.Sentence> :: e.Sentence,
//!	<Store-Vars <Vars e.out>> :: e.res-vars,
  <Vars <Gener-Vars (e.out) "res">> :: e.res-vars,
  <Vars-Decl e.res-vars> : e,
  <Store &Res-Vars e.res-vars>,
  <Store &Out-Format <Format-Exp e.out>>,
  <Gener-Vars (e.in) "arg"> :: e.in,
  <Vars e.in> :: e.arg-vars,
  <Vars-Decl e.arg-vars> : e,
  <Map &Set-Var- (Instantiated? True) (e.arg-vars)> : e,
  <Store &Arg-Vars e.arg-vars>,
  s.tag : {
    FUNC = FATAL;
    FUNC? = RETFAIL;
  } :: t.retfail,
  (FUNC t.name (<Vars-Print e.arg-vars>) (<Vars-Print e.res-vars>)
    <Comp-Sentence Tail ((t.retfail)) (e.in) e.Sentence>
  ) :: e.comp-func,
*	<Set-Drops () <Gener-Var-Names e.comp-func>> :: t e.comp-func,
  <Gener-Var-Names e.comp-func> :: e.comp-func,
//!	<Post-Comp (e.res-vars) e.comp-func> :: t e.result,
//!	e.result;
  e.comp-func;
//  :: (e.func-decl) e.func-body,
//  () <Domain &Declarations> $iter {
//    e.vars : (t.var) e.rest-vars,
//      (e.var-decls (DECL t.var)) e.rest-vars;
//  } :: (e.var-decls) e.vars,
//  e.vars : /*empty*/,
//  (e.func-decl e.var-decls e.func-body);

Ref-To-Var e.Snt =
  () e.Snt $iter {
    e.Snt : t.Statement e.rest, t.Statement : {
      (REF t.name) = (e.new-Snt /*<New-Vars (VAR REF t.name)>*/) e.rest;

//!			<Table> :: s.tab,
//!			<Bind &Vars-Tab (t.name) (s.tab)>,
//!			<Set-Var t.name (Format) (<Format-Exp (REF t.name)>)>,
//!			<Set-Var t.name (Declared) (True)>,
//!			<Set-Var t.name (Instantiated) (True)>,
//!			<Set-Var t.name (Left-compare) ()>,
//!			<Set-Var t.name (Right-compare) ()>,
//!			<Set-Var t.name (Left-checks) ()>,
//!			<Set-Var t.name (Right-checks) ()>,
//!			(e.new-Snt (VAR t.name)) e.rest;

      (e.expr) = (e.new-Snt (<Ref-To-Var e.expr>)) e.rest;
      t = (e.new-Snt t.Statement) e.rest;
    };
  } :: (e.new-Snt) e.Snt,
  e.Snt : /*empty*/ =
  e.new-Snt;

Set-Drops (e.declared) e.comp-func =
  e.comp-func () (e.declared) $iter {
    e.comp-func : t.first e.rest, {
      t.first : \{
        (EXPR t.var e) = (DROP t.var) (t.first) t.var Init;
        (DEREF t.var e) = (DROP t.var) (t.first) t.var Init;
        (SUBEXPR t.var e) = (DROP t.var) (t.first) t.var Init;
        (DECL Expr t.var) = (DROP t.var) () t.var Decl;
        (DECL "int" t.var) = /*empty*/ () t.var Decl;
      } :: e.drop (e.constr) t.var s.init,
        {
          e.declared : e1 t.var s.old-init e2, s.old-init : {
            Init, {
              t.var : (VAR ("const" e)) =
                e.rest (e.result-func) (e.declared);
              e.rest (e.result-func e.drop e.constr) (e.declared);
            };
            Decl, s.init : {
              Decl =
                e.rest (e.result-func) (e.declared);
              Init =
                t.first : (s.method t.var e.args),
                e.rest (e.result-func (ASSIGN t.var (s.method e.args)))
                (e1 e2 t.var s.init);
                /*
                 * FIXME: if s.method is EXPR, it shouldn't be written.
                 */
            };
          };
          e.rest (e.result-func t.first) (e.declared t.var s.init);
        };
      t.first : (LABEL (t.label) e.expr) =
        <Set-Drops (e.declared) e.expr> :: (e.declared) e.expr,
        e.rest (e.result-func (LABEL (t.label) e.expr)) (e.declared);
      t.first : (e.expr) =
        <Set-Drops (e.declared) e.expr> :: t e.expr,
        e.rest (e.result-func (e.expr)) (e.declared);
      t.first : s.symbol =
        e.rest (e.result-func s.symbol) (e.declared);
    };
  } :: e.comp-func (e.result-func) (e.declared),
  e.comp-func : /*empty*/ =
  (e.declared) e.result-func;


Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Sentence, e.Sentence : {

  /*empty*/ = /*empty*/;

  /*
   * In case of Re look if we should do a tailcall.  If not, then compile
   * function calls from the Re and assign results to the out parameters or
   * use them in compilation of the rest of the sentence.
   */
  (RESULT e.Re) e.Snt =
    {
      /*
       * If the Re is the last action in the sentence then we can do
       * tailcall if one of the following is true:
       *  - Re is a call of non-failable function;
       *  - Re is a call of a failable function, current function is
       *  failable, and the failures stack is empty.
       * In both cases out format of the called function should coincide
       * with those of compiled one.
       * FIXME: really we can do tailcall if all the parameters of
       * compiled function that won't get their values from the call can
       * be assigned from other sources.  Some support from runtime is
       * needed though.
       */
      e.Snt : /*empty*/, s.tail? : Tail, e.Re : (CALL t.name e.arg),
        { <In-Table? &Fun? t.name> = v.fails : (RETFAIL);; },
        <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
        <Subformat? (e.Fout) (<? &Out-Format>)> =
        <Extract-Calls e.arg> :: (e.last-Re) e.calls,
        <Comp-Static-Exprs <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
        <Comp-Calls <R 0 v.fails> e.calls>
        (TAILCALL t.name (e.splited-Re) (<? &Res-Vars>));

      <Extract-Calls e.Re> :: (e.last-Re) e.calls,
        <Comp-Calls <R 0 v.fails> e.calls> :: e.comp-calls,
        {
          e.Snt : /*empty*/, s.tail? : Tail =
            <Split-Re (<? &Out-Format>) e.last-Re> :: e.splited-Re,
            <Comp-Static-Exprs e.splited-Re> :: e.splited-Re,
            e.comp-calls <Comp-Assigns <Zip (<? &Res-Vars>) (e.splited-Re)>>;

          e.comp-calls <Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Snt>;
        };
    };

  /*
   * In case of He compile assignments from last Re and then (with new state
   * of variables) proceed with the rest of the sentence.
   */
  (FORMAT e.He) e.Snt =
    <Comp-Format (e.last-Re) e.He>
    <Comp-Sentence s.tail? (v.fails) () e.Snt>;

  /*
   * In case of Pe get from the begining of the sentence a maximum possible
   * sequence of clashes and compile it.  New values of variables from the
   * clashes use in the compilation of the rest of the sentence.
   */
  (s.dir e.Pattern) e.Snt, s.dir : \{ LEFT; RIGHT; } =
    <Get-Clash-Sequence (e.last-Re) e.Sentence> :: (e.clashes) e.Sentence,
//    <WriteLN XXX e.clashes>,
    <Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence>;

  (s.block) e, BLOCK BLOCK? : e s.block e = <WriteLN! &StdErr "Empty block?">, $fail;

  /*
   * In case of a block first see if its results are needed for something
   * after the block and determine whether the block is a source.  Then
   * compile each branch in turn.
   */
  (s.block e.branches) e.Snt,
    s.block : \{
      BLOCK = (FATAL);
      BLOCK?;
    } :: e.fatal? =
    /*
     * If the block initializes an $iter then extract from the $iter the He
     * for placing it in the end of each branch.
     * Then look if the block is used by a pattern or format expression.
     * If so, we should declare variables from that expression before
     * entering any branch -- those should be visible after the block.
     * If next after the block is (Comp Error) then block results should be
     * used as values for $error, so place (Comp Error) in the end of each
     * branch.
     */
    {
      e.Snt : (ITER t.body t.format t.cond) e.rest =
        t.format (Comp Iter t.body t.format t.cond) e.rest;
      e.Snt;
    } :: e.Snt,
    e.Snt : {
      t.first e.rest, t.first : \{
        (LEFT e.pattern) = e.pattern;
        (RIGHT e.pattern) = e.pattern;
        (FORMAT e.format) = e.format;
      } :: e.expr =
        <Vars e.expr> :: e.vars,
*				<New-Vars e.vars>,
        (<Vars-Decl e.vars>) (t.first) ((Comp Source)) e.rest;
      (Comp Error) e.rest =
        () ((Comp Error)) () /*empty*/;
      e = () () () e.Snt;
    } :: (e.decls) (e.next-term) (e.source?) e.Snt,
    /*
     * The block is a source if after it goes pattern or format expression
     * (in that case e.source? isn't empty) or e.Snt isn't empty.
     * Branches in the block are tail sentences if the current sentence is
     * tail and the block isn't a source.
     */
    {
      \{ e.source? : v; e.Snt : v; } = ((Comp Source)) Notail;
      s.tail? : Tail = () Tail;
      () Notail;
    } :: (e.source?) s.tail-branch?,
    /*
     * In case our block is a source we should mark the position in the
     * failures stack, so that we can jump to it after CUTALL.  And if our
     * block isn't failable we should add (FATAL) to the end of the stack.
     */
    v.fails e.source? e.fatal? :: v.branch-fails,
    /*
     * We put all compiled branches in a block, so positive return from a
     * branch is a break from that block.
     * Each branch in its turn is placed in its own block, so for a $fail
     * to the next branch we should just break from that inner block.
     * Each branch is compiled with the current sentence state and the
     * state is recalled after that.  When all branches are compiled the
     * state is popped out from the stack.
     * If last branch fails then the whole block fails, and return from the
     * last branch is return from the block.  So the last branch isn't
     * placed in a block and is processed with the failures stack that was
     * before entering the block.  Note: this trick helps us find more
     * tailcalls.  If the call of a failable function is on the last branch
     * of the block and the failures stack is empty we can do tailcall.
     * When the last branch is compiled with the block's stack, all we
     * should do is to check it.
     */
    <Gener-Label "block"> :: t.label,
    <Save-Snt-State>,
    (e.branches) /*e.comp-branches*/ $iter {
      e.branches : (BRANCH e.branch) e.rest-br =
        <Add-To-Label t.label "branch"> :: t.br-label,
        <Comp-Sentence
          s.tail-branch?
          (v.branch-fails ((BREAK t.br-label)))
          (e.last-Re)
          e.branch e.next-term
        > :: e.comp-br,
        <Recall-Snt-State>,
        (e.rest-br) e.comp-branches (LABEL (t.br-label) e.comp-br (BREAK t.label));
    } :: (e.branches) e.comp-branches,
    e.branches : (BRANCH e.branch) =
    <Comp-Sentence
      s.tail-branch? (v.branch-fails) (e.last-Re) e.branch e.next-term
    > :: e.last-branch,
    <Pop-Snt-State>,
    e.decls (LABEL (t.label) e.comp-branches e.last-branch)
    <Comp-Sentence s.tail? (v.fails) () e.Snt>;

  /*
   * In case of $iter first of all compile initial assignment to the hard
   * expression.
   */
  (ITER t.body t.format t.cond) e.Snt =
    <Comp-Sentence s.tail? (v.fails) (e.last-Re)
      t.format (Comp Iter t.body t.format t.cond) e.Snt
    >;

  /*
   * Then compile $iter condition and body both with the current state of the
   * sentence.
   * e.Snt can contain only (Comp Error), so compile it together with the
   * condition.
   * If condition fails we should compute the body, so put the compiled
   * condition in a block and place a break from it to the failures stack.
   */
  (Comp Iter (BRANCH e.body) t.format (BRANCH e.condition)) e.Snt =
    <Gener-Label "iter"> :: t.label,
    <Gener-Label "exit_iter"> :: t.exit,
    <Save-Snt-State>,
    <Comp-Sentence s.tail? (v.fails ((BREAK t.label))) () e.condition e.Snt>
      :: e.comp-condition,
    <Pop-Snt-State>,
    <Comp-Sentence Notail (v.fails) () e.body t.format> :: e.comp-body,
    (FOR (/*cont-label*/) (t.exit) () ()
      (LABEL (t.label) e.comp-condition (BREAK t.exit)) e.comp-body
    );

  /*
   * In case of $trap/$with at first compile try-sentence.  All $fails from
   * it should become errors.
   * Then recall the state of the sentence and compile catching of an error
   * with a variable err.
   * e.Snt can be only (Comp Error), so compile it together with both
   * sentences -- when either of it comuptes to an object expression it
   * becomes a value of the $error.
   */
  (TRY (BRANCH e.try) e.catch) e.Snt =
    <Save-Snt-State>,
    <Comp-Sentence Notail ((FATAL)) () e.try e.Snt> :: e.comp-try,
    <Pop-Snt-State>,
    <Comp-Sentence s.tail? (v.fails) () (RESULT (EVAR ("err" 0))) e.catch e.Snt>
      :: e.comp-catch,
    (TRY e.comp-try) (CATCH-ERROR e.comp-catch);

  /*
   * In case of \? add Stake to the failures stack.  Add last fail after it
   * for <R 0 v.fails> continue to work.
   */
  (STAKE) e.Snt =
    <Comp-Sentence s.tail? (v.fails (Comp Stake) <R 0 v.fails>) () e.Snt>;

  /*
   * In case of \! forget all failure catchers after last \?.
   * If there is no Stake then we are inside negation or error (we assume the
   * program is correct).  So the right failure catcher is in the bottom of
   * the stack.
   */
  (CUT) e.Snt =
    {
      v.fails : $r v.earlier-fails (Comp Stake) e = v.earlier-fails;
      <L 0 v.fails>;
    } :: v.fails,
    <Comp-Sentence s.tail? (v.fails) () e.Snt>;

  /*
   * In case of = clear the failures stack up to the closest source.
   */
  (CUTALL) e.Snt =
    {
      v.fails : $r v.earlier-fails (Comp Source) e = v.earlier-fails;
      <L 0 v.fails>;
    } :: v.fails,
    <Comp-Sentence s.tail? (v.fails) () e.Snt>;

  /*
   * In case of = in the Refal-6 sense (non-transparent hedge for the fails),
   * $fail(k) should become $error(Fname "Unexpected fail"), so clear the
   * failures stack and put that value in it.
   */
  NOFAIL e.Snt =
    <Comp-Sentence s.tail? ((FATAL)) (e.last-Re) e.Snt>;

  /*
   * In case of $fail return last failure catcher.
   */
  (FAIL) e.Snt =
    v.fails : e (e.last-fail),
    e.last-fail;

  /*
   * In case of # we should proceed with the rest if the source is computed
   * to $fail.
   * We could compile the rest of the sentence and place it in the
   * failures stack.  But then the compiled sentence would be copied as many
   * times as there are $fail's to the upper level in the source.  So we
   * place compiled source in the block and put the break to exit from it in
   * the stack.
   * When compiling the source mark it as Notail as usual.
   * If the source isn't computed to $fail we should proceed with the last
   * failure catcher.
   */
  (NOT (BRANCH e.branch)) e.Snt =
    <Gener-Label "negation"> :: t.label,
    v.fails : e (e.last-fail),
//    <Save-Snt-State>,
    <Comp-Sentence Notail (((BREAK t.label))) () e.branch> e.last-fail
      :: e.comp-negation,
//    <Pop-Snt-State>,
    (LABEL (t.label) e.comp-negation) <Comp-Sentence s.tail? (v.fails) () e.Snt>;

//  (Comp Verbatim expr) = expr;

  /*
   * In case of $error all fails become $error(Fname "Unexpected fail").  So
   * place that value in the failures stack and then compile the computation
   * of the rest of the sentence and the last Re which should be the value of
   * $error.
   */
  (ERROR) e.Snt =
    <Comp-Sentence Notail ((FATAL)) e.Snt () (Comp Error)>;

  (Comp Error) e.Snt = (ERROR e.last-Re);

//  (Comp Fatal) = FATAL;

//  (Comp Retfail) = RETFAIL;

  (Comp Fail t.fail) e.Snt = <Comp-Sentence s.tail? (v.fails t.fail) () e.Snt>;

};



********** Sentence state stack and functions for work with it. **********

$box Snt-State;

/*
 * Put current state in the stack.
 */
Save-Snt-State = <Put &Snt-State <Vars-Copy-State>>;

/*
 * Set current state to that at the top of the stack.
 */
Recall-Snt-State = <Vars-Set-State <R 0 <? &Snt-State>>>;

/*
 * Pop the top from the stack and set current state to it.
 */
Pop-Snt-State =
  <Recall-Snt-State>,
  <Store &Snt-State <Middle 0 1 <? &Snt-State>>>;



********************** Function calls compilation. ***********************

/*
 * $func Extract-Calls e.Re = (e.last-Re) e.calls;
 *
 *
 *
 */
Extract-Calls {
  (CALL t.name e.arg) e.rest =
    <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
    <Extract-Calls e.arg> :: (e.last-Re) e.calls,
    <Comp-Static-Exprs <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
    <RFP-Extract-Qualifiers t.name> :: t e.prefix,
*		<Del-Pragmas <Gener-Vars 0 (e.Fout) e.prefix>> : e.Re s,
//!		<Store-Vars <Vars e.res-Re>> :: e.ress,
//!		<Instantiate-Vars e.ress>,
//!		<Ref-To-Var <Strip-STVE e.res-Re>> :: e.res-Re,
//!		e.decls <Declare-Vars "Expr" e.ress> :: e.decls,
    <Gener-Vars (e.Fout) e.prefix> :: /*(e.vars)*/ e.Re,
    <Vars e.Re> :: e.vars,
    <Map &Set-Var- (Instantiated? True) (e.vars)> : e,
    {
      s.tag : FUNC? =	(Failable (CALL t.name (e.splited-Re) (e.vars)));
      (CALL t.name (e.splited-Re) (e.vars));
    } :: t.call,
    <Extract-Calls e.rest> :: (e.rest-Re) e.rest-calls,
    (e.Re e.rest-Re) e.calls <Vars-Decl e.vars> t.call e.rest-calls;
  (PAREN e.Re) e.rest =
    <Extract-Calls e.Re> :: (e.last-Re) e.calls,
    <Extract-Calls e.rest> :: (e.rest-Re) e.rest-calls,
    ((PAREN e.last-Re) e.rest-Re) e.calls e.rest-calls;
  t.Rt e.Re =
    <Extract-Calls e.Re> :: (e.last-Re) e.calls,
    (t.Rt e.last-Re) e.calls;
  /*empty*/ = () /*empty*/;
};


Comp-Calls (e.fail) e.calls, e.calls : {
  (Failable t.call) e.rest =
    (IF ((NOT t.call)) e.fail) <Comp-Calls (e.fail) e.rest>;
  t.call e.rest =
    t.call <Comp-Calls (e.fail) e.rest>;
  /*empty*/ = /*empty*/;
};



*********** Compilation of static parts of result expressions ************

$func Static-Expr? s.create? e.Re = static? e.Re;

$func Static-Term? t.Rt = static? t.Rt;


/*
 * Extract static parts from each Re.
 * Also get the right names of arg-variables, if those are in the expr. 
 * FIXME: the function should be renamed.  In something reflecting expression
 * preparing for following doings.
 */
Comp-Static-Exprs {
  (e.Re) e.rest = <Static-Expr? Create e.Re> :: s e.Re, (e.Re) <Comp-Static-Exprs e.rest>;
  /*empty*/     = /*empty*/;
};


/*
 * Find all the longest static parts in the upper level of Re.  Create STATIC
 * form in place of each one.
 * Return a tag pointing whether the whole expression is static and expression
 * with static parts replaced by STATIC forms.  Dynamic parts are returned
 * unchanged.
 */
Static-Expr? {
  s.create? t.Rt e.Re =
    <Static-Term? t.Rt> : {
      Static t.Rt =
        {
          e.Re : e1 t2 e3, <Static-Term? t2> : Dynamic t.dyn-Rt =
            <Static-Expr? Create e3> :: s e3,
            Dynamic <Create-Static t.Rt e1> t.dyn-Rt e3;
          {
            s.create? : Create = Static <Create-Static t.Rt e.Re>;
            Static t.Rt e.Re;
          };
        };
      Dynamic t.dyn-Rt =
        <Static-Expr? Create e.Re> :: s e.Re,
        Dynamic t.dyn-Rt e.Re;
    };
  s.create? /*empty*/ = Static;
};


/*
 * The same as Static-Expr? but for terms.
 */
Static-Term? {
  symbol       = Static symbol;
  (PAREN e.Re) = <Static-Expr? Not-Create e.Re> :: static? e.Re, static? (PAREN e.Re);
  (REF t.name) = Static (REF t.name);
  (s.var-tag ("arg" s.n)) = Dynamic <L <"-" s.n 1> <? &Arg-Vars>>;
  t.var        = Dynamic t.var;
};



***************** Compilation of assignment to variables *****************

$func Comp-Assign-to-Var e = e;

Comp-Assign-to-Var (t.var (e.Re)) =
  {
    <Flat? e.Re> = (Flat? True);;
  } :: e.flat?,
  <Set-Var (Instantiated? True) e.flat? t.var>,
  {
    t.var : e.Re = /*empty*/;
    <Generated-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
    <Get-Var Decl t.var> : s = (ASSIGN <Vars-Print t.var> e.Re);
    <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
  };

Comp-Assigns e.assigns = <Map &Comp-Assign-to-Var (e.assigns)>;



************************** FORMAT compilation. ***************************

$box Aux-Index;

$func Gener-Aux-Var = t.new-aux-var;

Gener-Aux-Var =
  <? &Aux-Index> : s.n,
  <Store &Aux-Index <"+" s.n 1>>,
  (VAR ("aux" s.n));


$func Create-Aux-Vars (e.vars) e.splited-Re = e.assigns;


Comp-Format (e.last-Re) e.He =
  <Vars e.He> :: e.vars,
  <Comp-Static-Exprs <Split-Re (<Format-Exp e.He>) e.last-Re>> :: e.splited-Re,
  <Store &Aux-Index 1>,
  <Create-Aux-Vars (e.vars) e.splited-Re> :: e.assigns,
  <Comp-Assigns e.assigns>;

/*
 * Итак, e.vars -- все переменные, входящие в форматное выражение.  Каждая
 * переменная может входить в форматное выражение только один раз, поэтому
 * повторяющихся среди них нет.
 * e.splited-Re -- набор результатных выражений.  На каждую переменную из
 * e.vars по выражению, которое должно быть ей присвоено.
 * 
 * Если переменная t.var_i используется в выражении e.Re_j, и i /= j, то
 * переменной t.var_j значение должно быть присвоено раньше, чем перeменной
 * t.var_i.  Если же, по аналогичным соображениям, t.var_i должна получить
 * значение раньше t.var_j, необходимо завести вспомогательную переменную.
 *
 * Пример:
 * 
 * t1 (t1 t2) (t1 t3) :: t2 t1 t3
 *
 * t3 = (t1 + t3)();
 * aux_1 = t1;
 * t1 = (t1 + t2)()
 * t2 = aux_1;
 * 
 * В общем случае вспомогательная переменная требуется, если двум переменным
 * необходимы старые значения друг друга (возможно, не напрямую, а через
 * промежуточные переменные).
 *
 * Вместо того, чтобы искать и анализировать такие циклы, будем действовать по
 * методу "наибольшей пользы".  А именно:
 * 
 *   - Для каждой переменной выпишем все другие переменные, которым требуется
 *     её старое значение, а также отдельно те, старые значения которых
 *     требуются ей.
 *
 *   - Всем переменным, от старых значений которых ничего не зависит, можно
 *     смело присвоить новые значения.  При этом они исчезают из списков
 *     зависимостей оставшихся переменных.
 *
 *   - Все переменные, новые значения которых ни от чего не зависят, можно
 *     отложить, чтобы присвоить им значения тогда, когда будет удобно.  Т.е.
 *     тогда, когда списки зависящих от них переменных опустеют.
 *
 *   - Чтобы означить оставшиеся, нужны вспомогательные переменные.  Выберем
 *     одну из переменных, с максимальным списком тех, от которых она зависит,
 *     и положим её значение во вспомогательную переменную.  Так как мы сразу
 *     уменьшили кол-во зависимостей у максимального кол-ва переменных,
 *     локально мы добились наибольшей пользы, хотя не исключено, что глобально
 *     такой метод и не даст наименьшего кол-ва вспомогательных переменных.
 *     Кроме того, мы не пытаемся выбрать наилучшую переменную из нескольких с
 *     максимальным списком зависимостей.
 *
 *   - Повторяем всё это до тех пор, пока у каждой переменной не опустеет
 *     список зависящих от неё.
 *
 *
 * Для нашего примера:
 * 
 * t1 (t1 t2) (t1 t3) :: t2 t1 t3
 *
 * t1 -- (t2 t3) (t2)
 * t2 -- (t1)    (t1)
 * t3 -- ()      (t1)
 *
 *
 * Для каждой переменной var_i найдём все j /= i, такие что в Re_j встречается
 * var_i -- provide[i], и а также все j /= i, такие что var_j нужна для
 * подсчёта var_i, т.е. встречается в Re_i.
 *
 * Res-vars <- <Map &Vars (Res)>
 * for var_i in vars
 *     provide[i] <-
 *     for vars-Re_j in Res-vars, j /= i
 *         vars-Re_j : e var_i e = j
 *     require[i] <- <Res-vars[i] `*` vars[^i]> : e var_j e, j
 *
 * Res-vars = map Vars Res
 * provide, require =
 *   {   [ j | vars-Re_j <- Res-vars, j /= i, var_i `in` vars-Re_j ]
 *     , [ j | var_j <- Res-vars[i] `*` vars, i /= j]
 *     | var_i <- vars
 *   }
 *
 */

$func CAV e.vars (e.assigns) (e.delayed) = e.assigns;

$func Get-Vars e = e;
Get-Vars (e.Re) = (<Vars e.Re>);

Create-Aux-Vars (e.vars) e.splited-Re =
  <Zip (<Map &Get-Vars (e.splited-Re)>) (e.vars)> :: e.list,
  <Box> :: s.box,
  <Box> :: s.provide-i,
  <Box> :: s.require-i,
  {
    e.vars : e1 t.var-i e2,
      {
        e.list : e ((e.vars-Re) t.var-j) e,
          \{
            t.var-i : t.var-j = <Put s.require-i <And (e1 e2) e.vars-Re>>;
            e.vars-Re : e t.var-i e = <Put s.provide-i t.var-j>;
          },
          $fail;
        <L <Length e1> e.splited-Re> :: t.Re-i,
        <Put s.box (t.var-i t.Re-i (<? s.provide-i>) (<? s.require-i>))>,
          <Store s.provide-i /*empty*/>,
          <Store s.require-i /*empty*/>;
      },
      $fail;;
  },
  <CAV <? s.box> (/*assigns*/) (/*delayed*/)>;


/*
 * Если есть переменная, у которой список provide пуст, её можно посчитать.
 * Это выражается в том, что она (вместе с присваиваемым значением) добавляется
 * в список assigns, убирается из списка vars, а также из всех списков provide
 * и delayed.  В списках require её не было.
 *
 * CAV Res vars provide require assigns delayed =
 *   { i | var_i <- vars, provide_i == [] } ->     // Здесь неверно!  На переменные
 *                                                    из delayed тоже надо смотреть.
 *       vars    = vars - var_i
 *       provide = [ provide_j - i | provide_j <- provide ]
 *       assigns = assigns++[(var_i, Res[i])]
 *       delayed = [ (var_j, provide_j - i) | (var_j, provide_j) <- delayed ]
 *       CAV Res vars provide require assigns delayed
 */

$func Assign-Empty-Provides e.vars  = e.assigns (e.vars);

Assign-Empty-Provides {
  e1 (t.var-i t.Re-i (/*empty provide_i*/) (e.require-i)) e2 =
    <Box> :: s.vars,
    {
      e1 e2 : e (t.var-j t.Re-j (e.provide-j) (e.require-j)) e,
        <Put s.vars (t.var-j t.Re-j (<Sub (e.provide-j) t.var-i>) (e.require-j))>,
        $fail;;
    },
    (t.var-i t.Re-i) <Assign-Empty-Provides <? s.vars>>;
  e.vars = /*empty*/ (e.vars);
};


/*
 * Если есть переменная, у которой список require пуст, кладём её в delayed.
 * Она будет посчитана, когда у неё опустеет список provide, т.е. когда не
 * останется переменных, у которых она в списке require.
 */
$func Delay-Empty-Requires e.vars  = e.delayed (e.vars);

Delay-Empty-Requires {
  e1 t.var e2, t.var : (t.var-i t.Re-i (e.provide-i) (/*empty require_i*/)) =
    <Delay-Empty-Requires e2> :: e.delayed (e.vars),
    t.var e.delayed (e1 e.vars);
  e.vars = /*empty*/ (e.vars);
};


/*
 * Выбор переменной (из двух) с более длинным списком требуемых ей значений.
 */
$func Max-Require e = e;

Max-Require t.arg1 t.arg2 =
  t.arg1 : (t.var1 t.Re1 t.provide1 (e.require1)),
  t.arg2 : (t.var2 t.Re2 t.provide2 (e.require2)),
  {
    <"<" (<Length e.require1>) (<Length e.require2>)> = t.arg2;
    t.arg1;
  };


/*
 * Подставить вспомогательную переменную вместо исходной во всех результатных выражениях.
 * Присваивание к исходной переменной убрать (оно к этому моменту уже выполнено).
 * Убрать переменную из списков зависимостей.
 */
$func Subst-Aux-Var e = e;

Subst-Aux-Var t.var t.aux (t.v t.Re (e.provide) (e.require)), {
  t.var : t.v = /*empty*/;
  (
    t.v
    <Subst (t.var) ((t.aux)) t.Re>
    (<Sub (e.provide) t.var>)
    (<Sub (e.require) t.var>)
  );
};


/*
 * Извлечь присваивание из всей информации о переменной.
 */
$func Extract-Assigns e = e;
Extract-Assigns (t.var t.Re e) = (t.var t.Re);


/*
 * Основной цикл обработки присваиваний.
 *
 * 1) Из всех переменных (в том числе и отложенных), от которых больше ничего
 *    не зависит, сделать присваивания.
 * 2) Все переменные, которые больше ни от чего не зависят, отложить.
 * 3) Если осталось хотя бы две неотложенных переменных, выбирать из них ту,
 *    которая зависит от наибольшего числа переменных, подставить везде вместо
 *    неё вспомогательную, перейти к пункту 1.
 */
CAV e.vars (e.assigns) (e.delayed) =
  <Assign-Empty-Provides e.vars> :: e.new-assigns (e.vars),
  e.assigns e.new-assigns <Assign-Empty-Provides e.delayed> :: e.assigns (e.delayed),
  e.delayed <Delay-Empty-Requires e.vars> :: e.delayed (e.vars),
  {
    e.vars : t t e =
      <Foldr1 &Max-Require (e.vars)> : (t.var t.Re e),
      <Gener-Aux-Var> :: t.aux,
      e.assigns (t.aux (t.var)) (t.var t.Re) :: e.assigns,
      <Map &Subst-Aux-Var t.var t.aux (e.vars)> :: e.vars,
      <Map &Subst-Aux-Var t.var t.aux (e.delayed)> :: e.delayed,
      <CAV e.vars (e.assigns) (e.delayed)>;
    e.assigns <Map &Extract-Assigns (e.vars e.delayed)>;
  };




****************** Компиляция сопоставления с образцом *******************

Get-Clash-Sequence (e.last-Re) t.Pattern e.Snt =
  (/*e.clashes*/) (RESULT e.last-Re) t.Pattern e.Snt $iter {
    e.Snt : (RESULT e.Re) (s.dir e.Pe) e.rest =
      /*
       * Компилируем все константные выражения и заводим в табличке все
       * незаведённые переменные.  У старых переменных очищается память
       * на предмет клешей, в которых они раньше использовались.
       */
      <Comp-Static-Exprs (e.Re) (e.Pe)> : (e.R1) (e.P1),
      <Map &Set-Var- (Clashes /*empty*/) (<Vars e.R1 e.P1>)> : e,
      (e.clashes (e.R1) (s.dir e.P1)) e.rest;
  } :: (e.clashes) e.Snt,
  # \{
    e.Snt : \{
      (RESULT e.Re) (LEFT e) e = e.Re;
      (RESULT e.Re) (RIGHT e) e = e.Re;
    } :: e.Re,
      <Without-Calls? e.Re>;
  } =
  (e.clashes) e.Snt;

Without-Calls? e.Re =
  e.Re $iter {
    e.Re : t.Rt e.rest =
      t.Rt : {
        (CALL e) = $fail;
        (BLOCK e) = $fail;
        (PAREN e.Re1) = <Without-Calls? e.Re1>;
        t.symbol-or-var = /*empty*/;
      },
      e.rest;
  } :: e.Re,
  e.Re : /*empty*/;

$func CC s.tail? (v.fails) t.end-cycle e.Snt = e.asail-Snt;

Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence =
  <Init-Clashes e.clashes>,
  <CC s.tail? (v.fails) <R 0 v.fails> e.Sentence>;

$func CC-Known-Lengths t.fail e.idxs = e.conds;

$func CC-Compute-Length t.fail t.end-cycle t.idx = e;

$func CC-Unknown-Lengths t.fail e.idxs = e.conds;

$func CC-Deref t.fail e.actions = e.actions;

$func CC-Eqs t.fail (e.assigns) e.eqs = e.actions;

$func CC-Compose-And-Compare t.fail = e.actions;

CC s.tail? (v.fails) t.end-cycle e.Snt, {
  <Domain &Known-Lengths> : v.clashes =
    <CC-Known-Lengths t.end-cycle v.clashes>
    <CC s.tail? (v.fails) t.end-cycle e.Snt>;
  <Domain &Compute-Length> : (t.clash) e =
    <CC-Compute-Length <R 0 v.fails> t.end-cycle t.clash>
    <CC s.tail? (v.fails) t.end-cycle e.Snt>;
  <Domain &Unknown-Lengths> : e.clashes =
    <CC-Unknown-Lengths t.end-cycle e.clashes> :: e.conds,
    <Update-Hard-Parts> : {
      v.actions =
        e.conds <CC-Deref <R 0 v.fails> v.actions>
        <CC s.tail? (v.fails) t.end-cycle e.Snt>;
      /*empty*/ =
        <Compose-Source-For-Deref> : {
          (e.assign) v.clshs =
            <Map &Reclassify-Clash (v.clshs)> : e,
            e.conds e.assign
            <CC s.tail? (v.fails) t.end-cycle e.Snt>;
          () /*empty*/ =
            e.conds <CC-Eqs <R 0 v.fails> () <? &Eqs>> :: e.actions,
            <Store &Eqs /*empty*/>,
            e.actions <CC-Compose-And-Compare <R 0 v.fails>> :: e.actions,
            {
              <Get-Cycle>
              :: (e.left) (e.right) (e.len) t.var t.l-var t.r-var =
                {
                  e.left : 0, e.right : 0 = /*empty*/ t.var;
                  <Gener-Vars ((VAR)) "subexpr_" t.var> : t.sub-var,
                    (SUBEXPR t.sub-var t.var (e.left)
                      ((INFIX "-" (e.len) (e.left e.right))))
                    t.sub-var;
                } :: e.subexpr t.var,
                <Gener-Label "continue"> :: t.cont-label,
                <Gener-Label "exit"> :: t.break-label,
                e.actions e.subexpr
                (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
                (FOR (t.cont-label) (t.break-label) () ((INC-ITER t.var))
                  (IF ((NOT (CHECK-ITER t.var))) <Concat <R 0 v.fails>>)
                  <CC s.tail?	(v.fails ((CONTINUE t.cont-label)))
                    <R 0 v.fails> e.Snt>
                  (BREAK t.break-label)
                );
              e.actions <Comp-Sentence s.tail? (v.fails) () e.Snt>;
            };
        };
    };
};

CC-Known-Lengths (e.fail) e.idxs, {
  e.idxs : (t.idx) e.rest =
    <Put &Checked-Lengths t.idx>,
    <Lookup &Known-Lengths t.idx> : (e.len-Re) (e.len-Pe),
    (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
    <CC-Known-Lengths (e.fail) e.rest>;
  <RFP-Clear-Table &Known-Lengths>;
};

CC-Compute-Length (e.fail) (e.end-cycle) t.idx =
  <Lookup &Compute-Length t.idx> : t.var s.mult (e.minuend) (e.subtrahend),
  <Create-Int-Var ("len") Aux e.minuend> :: t.m-var e.m-assign,
  <Create-Int-Var ("len") Aux e.subtrahend> :: t.s-var e.s-assign,
  <Get-Var Min t.var> :: e.min,
  ((INFIX "<" (t.m-var)
        ((INFIX "+" (t.s-var)
              ((INFIX "*" (e.min) (s.mult)))
  ))			)) :: e.min-cond,
  <Get-Var Max t.var> : {
    /*empty*/;
    e.max =
      ((INFIX ">" (t.m-var)
            ((INFIX "+" (t.s-var)
                  ((INFIX "*" (e.max) (s.mult)))
      ))			));
  } :: e.max-cond,
  (INFIX "%" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult)) :: e.div-cond,
  <Create-Int-Var ("len_") t.var
    (INFIX "/" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult))
  > :: t.len-var e.len-assign,
  <Set-Var (Length t.len-var) t.var>,
  <Unbind &Compute-Length t.idx>,
  <Put &Checked-Lengths t.idx>,
  <Get-Var Clashes t.var> :: e.clashes,
  <Map &Reclassify-Clash (<Sub (e.clashes) <? &Checked-Lengths>>)> : e,
  e.m-assign e.s-assign
  (IF ((INFIX "||" e.min-cond e.max-cond)) e.end-cycle)
  (IF (e.div-cond) e.fail)
  e.len-assign;

$func  Get-Min e = e;

$func? Get-Max e = e;

CC-Unknown-Lengths (e.fail) e.idxs, {
  e.idxs : (t.idx) e.rest =
    <Lookup &Unknown-Lengths t.idx> : (e.len-Re) (e.len-Pe) (e.vars-Re) (e.vars-Pe),
    {
      <Get-Max e.vars-Re> :: e.max =
        <Get-Min e.vars-Pe> :: e.min,
        ((INFIX "<" (e.len-Re e.max) (e.len-Pe e.min)));
      /*empty*/;
    } :: e.cond1,
    {
      <Get-Max e.vars-Pe> :: e.max =
        <Get-Min e.vars-Re> :: e.min,
        ((INFIX ">" (e.len-Re e.min) (e.len-Pe e.max)));
      /*empty*/;
    } :: e.cond2,
    {
      e.cond1 : /*empty*/, e.cond2 : /*empty*/ = /*empty*/;
      (IF ((INFIX "||" e.cond1 e.cond2)) e.fail);
    } :: e.cond,
    e.cond
    <CC-Unknown-Lengths (e.fail) e.rest>;
  <RFP-Clear-Table &Unknown-Lengths>;
};

Get-Min
{
  t.var e.vars = <Get-Var Min t.var> <Get-Min e.vars>;
  /*empty*/ = /*empty*/;
};

Get-Max
{
  t.var e.vars = <Get-Var Max t.var> : v.max, v.max <Get-Max e.vars>;
  /*empty*/ = /*empty*/;
};

$func Pos (e.Re) s.dir e.pos = e.pos;

Pos {
  (e.Re) RIGHT e.pos = (INFIX "-" ((LENGTH e.Re)) ((e.pos)));
  (e.Re) LEFT  e.pos = e.pos;
};

CC-Deref (e.fail) e.actions, e.actions : {
  (SYMBOL? e.Re (s.dir e.pos)) e.rest =
    (IF ((SYMBOL? e.Re (<Pos (e.Re) s.dir e.pos>))) e.fail)
    <CC-Deref (e.fail) e.rest>;
  (DEREF t.var e.Re (s.dir e.pos)) e.rest =
    (DEREF t.var e.Re (<Pos (e.Re) s.dir e.pos>))
    <CC-Deref (e.fail) e.rest>;
  /*empty*/ = /*empty*/;
};

CC-Eqs (e.fail) (e.assigns) e.eqs, {
  e.eqs : ((e.Re) (s.dir e.pos) t.Pt (e.len)) e.rest =
    {
      e.Re : t,
        <Get-Known-Length e.Re> : e.len (), // FIXME: здесь надо использовать
                          //        калькулятор
        s.dir e.pos : \{
          LEFT 0;
          RIGHT e.len;
        } =
        e.Re;;
    } :: e.Re-term,
    {
      <Flat? e.Re> =
        { <Var? t.Pt> = <Set-Var (Flat? True) t.Pt>;; },
        FLAT-EQ;
      <Flat? t.Pt> =
        { e.Re-term : term, <Var? term> = <Set-Var (Flat? True) term>;; },
        FLAT-EQ;
      EQ;
    } :: s.eq,
    <Pos (e.Re) s.dir e.pos> :: e.pos,
    {
      \{
        <Get-Var Instantiated? t.Pt> : True = t.Pt (e.Re);
        t.Pt : \{
          (REF e);
          (STATIC e);
        }, {
          <Var? e.Re-term> = e.Re-term (t.Pt);
          t.Pt (e.Re);
        };
      } :: el (er),
        (IF ((NOT (s.eq el (er) (e.pos)))) e.fail) :: e.cond,
        {
          e.assigns : $r e1 (SUBEXPR t.Pt e.def) e2 =
            <CC-Eqs (e.fail) (e1 (SUBEXPR t.Pt e.def) e.cond e2)>;
          e.cond <CC-Eqs (e.fail) (e.assigns) e.rest>;
        };
      <Set-Var (Instantiated? True) t.Pt>,
        <CC-Eqs (e.fail) (e.assigns (SUBEXPR t.Pt e.Re (e.pos) (e.len))) e.rest>;
    };
  e.assigns;
};

CC-Compose-And-Compare (e.fail) =
  <Update-Hard-Parts> : e,
  {
    <? &Eqs> : v.eqs =
      <CC-Eqs (e.fail) () v.eqs>
      <Store &Eqs /*empty*/>
      <CC-Compose-And-Compare (e.fail)>;;
  };






* 	/*e.cond*/ (/*!e.clashes!*/) (/*e.fail*/) $iter {
* 		/*
* 		 * First of all see if we have a clash with all variables of known length
* 		 * and without length conditions written out.
* 		 */
* 		e.clashes : e1 (e.t1 Known-length e.t2 (e.Re) (s.dir e.Pe)) e2,
* 			<Hard-Exp? e.Re e.Pe> =
* 			e.cond
* 			(Cond IF ((INFIX "==" (<Length-of e.Re>) (<Length-of e.Pe>))))
* 			(e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2) (e.fail);
* 		/*
* 		 * Next see if we can compute length of some variable.
* 		 */
* 		e.cond <Find-Var-Length e.clashes> (e.fail);
* 		/*
* 		 * Write out restrictions for the cyclic variables.
* 		 */
* 		e.cond <Cyclic-Restrictions e.clashes> (e.fail);
* //		<Cyclic-Restrictions e.clashes> :: e.new-cond (e.clashes),
* //			{
* //				e.fail : v = e.cond e.new-cond (Clear-Restricted) (e.clashes) (e.fail); 
* //				e.cond e.new-cond (e.clashes) (e.fail);
* //			};
* 		/*
* 		 * After checking all possible lengthes at the upper level change
* 		 * <<current_label_if_fail>>.
* 		 */
* 		e.fail : v =
* 			(Contin e.fail) e.cond (Fail e.fail) (Clear-Restricted) (e.clashes) ();
* 		/*
* 		 * For all clashes with known left part check unwatched terms whether they
* 		 * are symbols or reference terms or not any.
* 		 */
* 		\?
* 		{
* 			<Check-Symbols e.clashes> : {
* 				v.new-cond (e.new-clashes) s =
* 					e.cond (Cond IF (v.new-cond)) (e.new-clashes) ();
* 				(e.new-clashes) New = e.cond (e.new-clashes) ();
* 				e \! $fail;
* 			};
* 			<PrintLN "Check-Symbols: don't know what to do... ;-)">, $fail;
* 		};
* 		/*
* 		 * And then try to compose new clash by dereferencing a part of some one.
* 		 */
* 		e.cond <Dereference-Subexpr e.clashes> ();
* 		/*
* 		 * If previous doesn't work then compare recursively all known
* 		 * subexpressions and all unknown repeated subexpressions with
* 		 * corresponding parts of source.
* 		 */
* 		<Compare-Subexpr e.clashes> :: e.new-cond (e.asserts) (e.new-clashes) s.new?,
* 			\{
* 				e.new-cond : v, {
* 					e.asserts : v =
* 						e.cond (Assert e.asserts) (Cond IF (e.new-cond)) (e.new-clashes) ();
* 					e.cond (Cond IF (e.new-cond)) (e.new-clashes) ();
* 				};
* 				e.asserts : v = e.cond (Assert e.asserts) (e.new-clashes) ();
* 				s.new? : New = e.cond (e.new-clashes) ();
* 			};
* 		/*
* 		 * Then get first uncatenated source and bring it to the normal
* 		 * form, i.e. concatenate and parenthesize until it became single
* 		 * known expression.
* 		 */
* 		e.cond <Get-Source e.clashes> ();
* 		/*
* 		 * Now it's time to deal with cycles.
* 		 */
* 		e.cond <Comp-Cyclic e.clashes>;
* 		/*
* 		 * At last initialize all new subexpressions from all clashes.
* 		 */
* 		e.clashes () $iter {
* 			e.clashes : (e t.Re (s.dir e.Pe)) e.rest,
* 				e.rest (e.new-cond <Get-Subexprs <Vars e.Pe>>);
* 		} :: e.clashes (e.new-cond),
* 			e.clashes : /*empty*/ =
* 			{
* 				e.new-cond : /*empty*/ = e.cond () ();
* 				e.cond (Assert e.new-cond) () ();
* 			};
* 	} :: e.cond (e.clashes) (e.fail),
* //	<WriteLN CC-Clashes e.clashes>,
* //	<WriteLN CC-Cond e.cond>,
* 	e.clashes : /*empty*/ =
* 
* 	e.cond () 0 $iter {
* 		e.cond : (Contin (CONTINUE t.label)) e.rest =
* 			e.rest (e.contin (Comp Continue t.label)) 0;
* 		e.cond (e.contin) 1;
* 	} :: e.cond (e.contin) s.stop?,
* 	s.stop? : 1 =
* //!	<Comp-Sentence () e.Current-Snt e.contin e.Other-Snts> :: e.asail-Snt,
* 	<Comp-Sentence s.tail? (v.fails) () e.Sentence> :: e.asail-Snt,
* 	e.cond (e.asail-Snt) () $iter {
* 		e.cond : e.some (e.last),
* 			e.last : {
* 				Cond e.condition =
* 					e.some ((e.condition e.asail-Snt)) (e.vars);
* 				Assert e.assertion =
* 					e.some (e.assertion e.asail-Snt) (e.vars);
* 				Fail e.fail1 =
* 					e.some (e.asail-Snt e.fail1) (e.vars);
* 				Restricted t.var =
* 					e.some (e.asail-Snt) (e.vars t.var);
* 				If-not-restricted t.var e.restr-cond, {
* 					e.vars : e t.var e = e.some (e.asail-Snt) (e.vars);
* 					e.some e.restr-cond (e.asail-Snt) (e.vars);
* 				};
* 				Clear-Restricted = e.some (e.asail-Snt) ();
* 			};
* 	} :: e.cond (e.asail-Snt) (e.vars),
* 	e.cond : /*empty*/ =
* 	e.asail-Snt/* <Comp-Sentence () e.Other-Snts>*/;


Find-Var-Length (e.fail) e.clashes =
//  <WriteLN Find-Var-Length e.clashes>,
  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 \?
  <Unknown-Vars e.Pe> :: e.new-Pe (e.Pe-unknown),
  <Unknown-Vars e.Re> :: e.new-Re (e.Re-unknown),
//  <Write Unknown>, <Write (e.Re-unknown)>, <WriteLN (e.Pe-unknown)>,
  e.Re-unknown e.Pe-unknown : {
    /*empty*/ =
      (e1 (e.t1 Known-length e.t2 (e.Re) (s.dir e.Pe)) e2);
    (VAR t.name) e.rest,
      e.rest $iter \{
        e.unknown : (VAR t.name) e.rest1 = e.rest1;
      } :: e.unknown,
      e.unknown : /*empty*/,
      <"-" <Length e.Re-unknown> <Length e.Pe-unknown>> : {
        0 \! $fail;
        s.diff, {
          <"<" (s.diff) (0)> =
            <"*" s.diff -1>
            (INFIX "-" (<Length-of e.new-Re>) (<Length-of e.new-Pe>));
          <">" (s.diff) (0)> =
            s.diff
            (INFIX "-" (<Length-of e.new-Pe>) (<Length-of e.new-Re>));
        } :: s.mult e.diff,
          t.name : (e.QualifiedName),
          (VAR ("len" e.QualifiedName)) :: t.len-var,
          {
            <?? t.name Max> :: e.max =
              (INFIX "<=" 
                (t.len-var)
                ((INFIX "*" (s.mult) (e.max)))
              );
            /*empty*/;
          } :: e.cond,
          e.cond
          (INFIX ">=" 
            (t.len-var)
            ((INFIX "*" (s.mult) (<?? t.name Min>)))
          )
          (NOT (INFIX "%"
            (t.len-var)
            (s.mult)
          )) :: e.cond,
          <Set-Var t.name (Max) (//(LENGTH (VAR t.name))
            (INFIX "/" (t.len-var) (s.mult))
          )>,
          <Set-Var t.name (Min) (<?? t.name Max>)>,
          <Set-Var t.name (Length) (<?? t.name Max>)>,
//          <WriteLN Unknown-Num s.mult> =
          (Restricted (VAR t.name))
          (Assert
            <Declare-Vars "int" t.len-var>
            (ASSIGN t.len-var e.diff)
          )
          (Cond IF (e.cond))
          (<Update-Ties (VAR t.name) e1>
            (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe))
          <Update-Ties (VAR t.name) e2>);
      };
    e.unknown \!
      e.t1 Unknown-length e.t2 : e.t3 Ties e.t4 =
      e.t1 : t.id e,
      e.unknown () $iter {
        e.unknown : (VAR t.name) e.rest, {
          e.tied : e (VAR t.name) e = e.rest (e.tied);
          <Entries (VAR t.name) (e.Re)> :: s.Re-ent e.new-Re,
            <Entries (VAR t.name) (e.Pe)> :: s.Pe-ent e.new-Pe,
            <"-" s.Re-ent s.Pe-ent> :: s.diff,
            {
              s.diff : 0 = e.rest (e.tied (VAR t.name));
              {
                <"<" (s.diff) (0)> =
                  <"*" s.diff -1> (e.new-Re) (e.new-Pe);
                s.diff (e.new-Pe) (e.new-Re);
              } :: s.diff (e.plus) (e.minus),
                (
                  t.id
                  (<Known-Length-of e.plus>)
                  (<Known-Length-of e.minus>)
                  s.diff
                ) :: t.tie,
                {
                  <?? t.name Ties> : {
                    e.c1 (t.id e) e.c2 = e.c1 e.c2;
                    e.ties = e.ties;
                  };
                  /*empty*/;
                } :: e.ties,
                {
                  e.ties : e t.tie e;
                  <Set-Var t.name (Ties) (e.ties t.tie)>;
                },
                e.rest (e.tied (VAR t.name));
            };
        };
      } :: e.unknown (e.tied),
      e.unknown : /*empty*/ =
      {
        e.t3 e.t4 : e Cyclic e = e.t3 e.t4;
        e.t3 e.t4 Cyclic;
      } :: e.tags,
      (e1 (e.tags (e.Re) (s.dir e.Pe)) e2);
  };

Known-Length-of e.expr =
  <Unknown-Vars e.expr> :: e.expr (e.vars),
  <Length-of e.expr> (e.vars);

Update-Ties t.var e.clashes =
  e.clashes () $iter {
    e.clashes : t.clash e.rest,
      t.clash : (e.tags (e.Re) (s.dir e.Pe)),
      {
        e.tags : e Ties e = e.rest (e.new-clashes t.clash);
        e.Re e.Pe : e t.var e =
          e.rest (e.new-clashes (e.tags Ties (e.Re) (s.dir e.Pe)));
        e.rest (e.new-clashes t.clash);
      };
  } :: e.clashes (e.new-clashes),
  e.clashes : /*empty*/ =
  e.new-clashes;

Cyclic-Restrictions e.clashes =
  e.clashes : e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2 =
  <Unknown-Vars e.Re e.Pe> :: e (e.unknown),
  e.unknown () $iter {
    e.unknown : t.var e.rest,
      t.var : (VAR (e.QualifiedName)),
      (VAR ("min" e.QualifiedName)) :: t.min-var,
      <Cyclic-Min t.var> :: e.min,
      {
        <Cyclic-Max t.var> :: e.max =
          e.rest (e.cond (Restricted t.var) (If-not-restricted t.var
            (Assert 
              <Declare-Vars "int" t.min-var> (ASSIGN t.min-var e.min)
            )
            (Cond IF ((INFIX "<=" (t.min-var) (e.max))))
        ));
        e.rest (e.cond);
      };
  } :: e.unknown (e.cond),
  e.unknown : /*empty*/ =
  e.cond (e1 (e.t1 e.t2 (e.Re) (s.dir e.Pe)) e2);

Cyclic-Min (VAR t.name) =
  <?? t.name Ties> () $iter {
    e.ties : (t (e.plus (e.plus-vars)) (e.minus (e.minus-vars)) s.mult) e.rest, {
      e.minus-vars () $iter \{
        e.minus-vars : t.var e.vars-rest,
          e.vars-rest (e.minus-maxes <Cyclic-Max t.var>);
      } :: e.minus-vars (e.minus-maxes),
        e.minus-vars : /*empty*/ =
        e.plus-vars () $iter {
          e.plus-vars : (VAR t.var-name) e.vars-rest =
            e.vars-rest (e.plus-mins <?? t.var-name Min>);
        } :: e.plus-vars (e.plus-mins),
        e.plus-vars : /*empty*/ =
        e.rest (e.mins ((INFIX "/"
          ((INFIX "-" (e.plus e.plus-mins) (e.minus e.minus-maxes))) (s.mult)
        )));
      e.rest (e.mins);
    };
  } :: e.ties (e.mins),
  e.ties : /*empty*/ =
  (<?? t.name Min>) e.mins :: e.mins,
  {
    e.mins : (e.min) = e.min;
    (MAX e.mins);
  };

Cyclic-Max (VAR t.name) =
  <?? t.name Ties> () $iter {
    e.ties : (t (e.plus (e.plus-vars)) (e.minus (e.minus-vars)) s.mult) e.rest, {
      e.plus-vars () $iter \{
        e.plus-vars : (VAR t.var-name) e.vars-rest,
          e.vars-rest (e.plus-maxes <?? t.var-name Max>);
      } :: e.plus-vars (e.plus-maxes),
        e.plus-vars : /*empty*/ =
        e.minus-vars () $iter {
          e.minus-vars : (VAR t.var-name) e.vars-rest =
            e.vars-rest (e.minus-mins <?? t.var-name Min>);
        } :: e.minus-vars (e.minus-mins),
        e.minus-vars : /*empty*/ =
        e.rest (e.maxes ((INFIX "/"
          ((INFIX "-" (e.plus e.plus-maxes) (e.minus e.minus-mins))) (s.mult)
        )));
      e.rest (e.maxes);
    };
  } :: e.ties (e.maxes),
  e.ties : /*empty*/ =
  {
    (<?? t.name Max>) e.maxes;
    e.maxes;
  } :: e.maxes,
  {
    e.maxes : /*empty*/ = $fail;
    e.maxes : (e.max) = e.max;
    (MIN e.maxes);
  };




$const New-Clash-Tags = Unknown-length Ties Check-symbols Deref Compare;


Get-Source e.clashes =
  e.clashes : e1 (e.tags (e.Re) (s.dir e.Pe)) e2,
  \{ 
    /*
     * If source is an instantiated variable then go to the next clash.
     */
    e.Re : (VAR t.name),
      <?? t.name Instantiated> : True = $fail;
    /*
     * If in source there is unknown variable then we can't compute it, so
     * go to the next clash.
     */
    e.Re $iter e.Re : {               
      (VAR t.name) e.rest =           
        \{                    
          <?? t.name Instantiated> : True;  
          <?? t.name Left-compare> : v;   
        }, e.rest;                
      t e.rest = e.rest;              
    } :: e.Re,                    
      e.Re : /*empty*/;             
  } =
//  <WriteLN Get-Source (e.tags (e.Re) (s.dir e.Pe))>,
  {
    e.Re : /*empty*/ =
      <Store-Vars (EVAR ("empty" 0))> : t.empty,
      <Set-Var ("empty") (Instantiated) (True)>,
      () () (e.tags (t.empty) (s.dir e.Pe));
    e.Re : (VAR t.name) =
      (e.Re) () (e.tags (e.Re) (s.dir e.Pe));
    {
      e.tags : e Without-object-symbols e =
        /*empty*/ (e.tags (e.Re) (s.dir e.Pe));
      <Get-Static-Exprs e.Re> :: e.Re (e.Re-decls),
        <Get-Static-Exprs e.Pe> :: e.Pe (e.Pe-decls) =
        e.Re-decls e.Pe-decls (e.tags Without-object-symbols (e.Re) (s.dir e.Pe));
    } :: e.asserts (e.tags (e.Re) (s.dir e.Pe)), {
      e.Re : (VAR t.name) =
        () (e.asserts) (e.tags (e.Re) (s.dir e.Pe));
      <Compose-Expr e.Re> :: e.compose (e.not-inst) s.flat?,
        <Gener-Label "compose"> :: t.name,
        <Declare-Vars "Expr" (VAR t.name)> :: e.decl,
        <Instantiate-Vars (VAR t.name)>,
        {
          s.flat? : 0 = <Set-Var t.name (Flat) (True)>;;
        },
        <Set-Var t.name (Length) (<Length-of e.Re>)>,
        <Set-Var t.name (Format) (<Format-Exp e.Re>)> =
        (e.not-inst) (e.asserts e.decl (ASSIGN (VAR t.name) e.compose))
        (e.tags ((VAR t.name)) (s.dir e.Pe));
    };
  } :: (e.not-inst) (e.decl) t.clash,
  (Assert <Get-Subexprs e.not-inst> e.decl) (e1 t.clash e2);

Compose-Expr e.Re =
  e.Re () () 0 $iter {
    e.Re : t.Rt e.rest, t.Rt : {
      s.ObjectSymbol =
        <PrintLN "Compose-Expr: can't deal with object symbols!">, $fail;
      (PAREN e.expr) =
        <Compose-Expr e.expr> :: e.expr (e.new-not-inst) s,
        (PAREN e.expr) (e.new-not-inst) 1;
      (VAR t.name) =
        {
          <?? t.name Instantiated> : True = /*empty*/;
          t.Rt;
        } :: e.new-not-inst,
        {
          <?? t.name Flat> : True = 0;
          1;
        } :: s.new-flat?,
        (Used t.Rt) t.Rt (e.new-not-inst) s.new-flat?;
      t = t.Rt () 0; // STUB!
    } :: e.new-compose (e.new-not-inst) s.new-flat? =
      e.rest (e.compose e.new-compose) (e.not-inst e.new-not-inst)
      <"+" s.flat? s.new-flat?>;
  } :: e.Re (e.compose) (e.not-inst) s.flat?,
  e.Re : /*empty*/ =
  e.compose (e.not-inst) s.flat?;

Get-Subexprs e.vars =
//  <WriteLN Get-Subexprs e.vars>,
  e.vars () $iter {
    e.vars : (VAR t.name) e.rest,
      # \{ <?? t.name Instantiated> : True; },
      <?? t.name Left-compare> : (t.var s.dir (e.pos) (0) e.len) e =
      <Instantiate-Vars (VAR t.name)>,
      <Declare-Vars "Expr" (VAR t.name)> : e,
      {
        s.dir : Right =
          (INFIX "-" (<Length-of t.var>) (e.pos e.len));
        e.pos;
      } :: e.pos,
      e.rest (e.decls (Used t.var) (SUBEXPR (VAR t.name) t.var (e.pos) (e.len)));
    // STUB:
    e.vars : t e.rest = e.rest (e.decls);
  } :: e.vars (e.decls),
  e.vars : /*empty*/ =
  e.decls;

Comp-Cyclic e.clashes =
  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 =
  e.Re : (VAR (e.QualifiedName)),
  <Split-Hard-Left e.Pe> :: e.left-hard,
  <Split-Hard-Right e.Pe> :: e.right-hard,
  e.Pe : e.left-hard e.Cycle e.right-hard,
  {
    e.left-hard e.right-hard : /*empty*/ = /*empty*/ (e.QualifiedName) ();
    <Gener-Label "ref" e.QualifiedName> :: t.name,
      t.name : (e.CycleName),
      <Declare-Vars "Expr" (VAR t.name)> : e,
      <Instantiate-Vars (VAR t.name)>,
      <Set-Var t.name (Format) (<Format-Exp e.Cycle>)>,
      (INFIX "-" (<Length-of e.Re>) (<Length-of e.right-hard>)) :: e.len,
      (Used e.Re)
      (SUBEXPR (VAR t.name) e.Re (<Length-of e.left-hard>) (e.len)) :: e.decl,
      <Set-Var t.name (Left-compare)
        ((e.Re Left (<Length-of e.left-hard>) (0) <Length-of (VAR t.name)>))>,
      <Set-Var (e.QualifiedName) (Left-compare) ((
        (VAR t.name) Left (0) (<Length-of e.left-hard>) <Length-of (VAR t.name)>
      ))> =
      (e.t1 Checked-length e.t2 (e.Re) (s.dir e.left-hard (VAR t.name) e.right-hard))
      (e.CycleName) (e.decl);
  } :: e.old-clash (e.CycleName) (e.decl),
  (VAR (e.CycleName)) :: t.var,
  <Gener-Label L "For" "Break"> :: t.break-label,
  <Gener-Label L "For" "Cont"> :: t.cont-label,
  s.dir : {
    LEFT =
      e.Cycle : t.var-e1 e.rest,
      t.var-e1 : (VAR (e.SplitName)),
      {
//        e.rest : t.var-e2 = t.var-e2;
        (VAR <Gener-Label "lsplit" e.CycleName>);
      } :: t.var-e2,
      <Declare-Vars "Expr" t.var-e2> : e,
//!			<Instantiate-Vars t.var-e1 t.var-e2>
      (Assert 
        e.decl
        (LSPLIT t.var ((VAR ("min" e.SplitName))) t.var-e1 t.var-e2)
      )
      (Cond LABEL (t.break-label))
      (Cond FOR (t.cont-label) () ((INC-ITER t.var)))
      (Fail (BREAK t.break-label))
      (Clear-Restricted)
      (<Update-Ties t.var-e2 <Update-Ties t.var-e1 e1>>
        e.old-clash
        (<Gener-Label "clash"> &New-Clash-Tags (t.var-e2) (s.dir e.rest))
      <Update-Ties t.var-e2 <Update-Ties t.var-e1 e2>>)
      ((CONTINUE t.cont-label));
    RIGHT =
      e.Cycle : e.rest t.var-e2,
      t.var-e2 : (VAR (e.SplitName)),
      {
//        e.rest : t.var-e2 = t.var-e2;
        (VAR <Gener-Label "lsplit" e.CycleName>);
      } :: t.var-e1,
      <Declare-Vars "Expr" t.var-e1> : e,
      <Instantiate-Vars t.var-e1 t.var-e2>
      (Assert 
        e.decl
        (RSPLIT t.var ((VAR ("min" e.SplitName))) t.var-e1 t.var-e2)
      )
      (Cond LABEL (t.break-label))
      (Cond FOR (t.cont-label) () ((INC-ITER t.var)))
      (Fail (BREAK t.break-label))
      (Clear-Restricted)
      (<Update-Ties t.var-e2 <Update-Ties t.var-e1 e1>>
        e.old-clash
        (<Gener-Label "clash"> &New-Clash-Tags (t.var-e1) (s.dir e.rest))
      <Update-Ties t.var-e2 <Update-Ties t.var-e1 e2>>)
      ((CONTINUE t.cont-label));
  };

Split-Hard-Left e.expr =
  e.expr () $iter {
    e.expr : t.Pt e.rest, {
      <Hard-Exp? t.Pt> = e.rest (e.hard t.Pt);
      (e.hard);
    };
  } :: e.expr (e.hard),
  e.expr : /*empty*/ =
  e.hard;

Split-Hard-Right e.expr =
  e.expr () $iter {
    e.expr : e.some t.Pt, {
      <Hard-Exp? t.Pt> = e.some (t.Pt e.hard);
      (e.hard);
    };
  } :: e.expr (e.hard),
  e.expr : /*empty*/ =
  e.hard;

Gener-Label e.QualifiedName =
  {
    <Lookup &Labels e.QualifiedName> : s.num,
      <"+" s.num 1>;
    1;
  } :: s.num,
  <Bind &Labels (e.QualifiedName) (s.num)>,
  (e.QualifiedName s.num);

Add-To-Label (e.label) e.name = <Gener-Label e.label "_" e.name>;

Get-Static-Exprs e.Re =
  e.Re () () () $iter {
    e.Re : t.Rt e.rest, t.Rt : {
      s.ObjectSymbol, {
        <Char? t.Rt> =
          e.rest (e.new-Re) (e.decls) (e.expr t.Rt);
        <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
          {
            <Int? t.Rt> = "int";
            <Word? t.Rt> = "word";
          } :: s.prefix,
          <Get-Static-Var s.prefix t.Rt> :: e.Rt-var (e.Rt-decl) =
          e.rest (e.new-Re e.expr-var e.Rt-var)
          (e.decls e.expr-decl e.Rt-decl) ();
      };
      (PAREN e.paren-Re) =
        <Get-Static-Exprs e.paren-Re> :: e.new-paren-Re (e.paren-decls),
        <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
        e.rest (e.new-Re e.expr-var (PAREN e.new-paren-Re))
        (e.decls e.expr-decl e.paren-decls) ();
      t.var =
        <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
        e.rest (e.new-Re e.expr-var t.var) (e.decls e.expr-decl) ();
    };
  } :: e.Re (e.new-Re) (e.decls) (e.expr),
//  <WriteLN Get-Static-Exprs e.Re>,
  e.Re : /*empty*/ =
  <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
  e.new-Re e.expr-var (e.decls e.expr-decl);

Get-Static-Var s.prefix e.expr, {
  e.expr : /*empty*/ = /*empty*/ ();
  {
    <Lookup &Static-Exprs s.prefix e.expr> : t.var = t.var ();
    ("const" s.prefix e.expr) :: t.name,
      <Bind &Static-Exprs (s.prefix e.expr) ((VAR t.name))>,
      <Declare-Vars "Expr" (VAR t.name)> : e,
      <Instantiate-Vars (VAR t.name)>,
      <Set-Var t.name (Flat) (True)>,
      <Length e.expr> :: s.len,
      <Set-Var t.name (Length) (s.len)>,
      <Set-Var t.name (Min) (s.len)>,
      <Set-Var t.name (Max) (s.len)>,
      <Set-Var t.name (Format) (e.expr)> =
      (VAR t.name) ((EXPR (VAR t.name) e.expr));
  };
};




Length-of {
  /*empty*/ = 0;
  e.Re =
    e.Re () $iter {
      e.Re : t.Rt e.rest, t.Rt : {
        s.ObjectSymbol = 1;	// Может появиться из константы.
        (PAREN e) = 1;
        (REF t.name) = ; //<Ref-Len t.name>;  STUB!!!
        (STATIC t.name) = <Length-of <Get-Static t.Rt>>;
        t, <Var? t.Rt>, {
          <Get-Var Length t.Rt> : v.len = v.len;
          (LENGTH t.Rt);
        };
      } :: e.new-len,
      e.rest (e.Length e.new-len);
    } :: e.Re (e.Length),
    e.Re : /*empty*/ =
    e.Length;
};



Flat? {
  term e.rest =
    \{
      <Get-Var Flat? term> : True;
      term : \{
        (REF e) = term;
        (STATIC e) = <Get-Static term>;
      } :: e.Re,
        <Flat-Const? e.Re>;
    },
    <Flat? e.rest>;
  /*empty*/;
};

Flat-Const? {
  (PAREN e) e = $fail;
  (REF t.name) e.rest, {
    <Middle 3 0 <Lookup &Const t.name>> :: e.const =
      <Flat-Const? e.const> <Flat-Const? e.rest>;
    <Flat-Const? e.rest>;
  };
  s.ObjectSymbol e.rest =
    &Flat-Symbols : e s.f e, <Apply s.f s.ObjectSymbol> : e =
    <Flat-Const? e.rest>;
  /*empty*/;
};



/*
 * Ends good if lengths of all variables in the upper level of e.expr can be
 * calculated.
 */
Hard-Exp? e.expr =
  e.expr $iter {
    e.expr : t.first e.rest =
    {
      <Var? t.first>, {
        <Get-Var Instantiated? t.first> : True;
        <Get-Var Length t.first> : v;
        = $fail;
      };;
    },
      e.rest;
  } :: e.expr,
  e.expr : /*empty*/;

/*
 * Returns those parts of e.expr which lengthes are known. Also returns a list
 * of variables with unknown lengthes.
 */
Unknown-Vars e.expr =
  e.expr () () $iter {
    e.expr : t.first e.rest, {
      t.first : (VAR t.name), {
        <?? t.name Instantiated> : True =
          e.new-expr t.first (e.unknown);
        <?? t.name Max> :: e.max, <?? t.name Min> : e.max =
          e.new-expr t.first (e.unknown);
        e.new-expr (e.unknown t.first);
      };
      e.new-expr t.first (e.unknown);
    } :: e.new-expr (e.unknown) =
      e.rest (e.new-expr) (e.unknown);
  } :: e.expr (e.new-expr) (e.unknown),
  e.expr : /*empty*/ =
  e.new-expr (e.unknown);



Print-Error s.WE e.Descrip t.Pragma =
  <? &Error-Counter> : s.n,
  <Store &Error-Counter <"+" s.n 1>>,
  <Print-Pragma &StdErr t.Pragma>,
  <Print! &StdErr " " s.WE " ">,
  s.WE e.Descrip : {
    Error! Re = <PrintLN! &StdErr "Wrong format of result expression">;
    Error! Call = <PrintLN! &StdErr "Wrong argument format in function call">;
    Error! Pattern = <PrintLN! &StdErr "Wrong format of pattern expression">;
    Warning! Pattern = <PrintLN! &StdErr "Clash can't be solved">;
    Error! Var-Re t.var =
      <PrintLN! &StdErr "Unknown variable '"
                <AS-To-Ref t.var> "' in result expression">;
    Error! Var-Hard t.var =
      <PrintLN! &StdErr "Repeated occurence of the variable '"
                <AS-To-Ref t.var> "' in hard expression">;
    Error! Var-Type t.var s.type =
      <PrintLN! &StdErr "Incorrect type '" <AS-To-Ref s.type>
                "' of the variable '" <AS-To-Ref t.var> "'">;
    Error! Cut = <PrintLN! &StdErr "'\\\\!' without corresponding '\\\\?'">;
  };

Print-Pragma s.channel (PRAGMA e.pragmas),
  e.pragmas : {
    e (FILE e.file-name) e, <Print! s.channel e.file-name>, $fail;
    e (LINE s.line s.col) e, <Print! s.channel (s.line ", " s.col)>, $fail;
    e = <Print! s.channel ":">;
  };

AS-To-Ref {
  SVAR = 's';
  TVAR = 't';
  VVAR = 'v';
  EVAR = 'e';
  (s.tag t (e.name)) = <AS-To-Ref s.tag> '.' <To-Chars e.name>;
};

Lookup-Func t.Fname, \{
  <Lookup &Fun t.Fname>;
  <Lookup &Fun? t.Fname>;
} : s.linkage s.tag t.pragma (e.Fin) (e.Fout) =
  s.linkage s.tag t.pragma (e.Fin) (e.Fout);