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

$use Arithm Box Class Convert Dos StdIO Table;

$use "rfp_helper";
$use "rfp_list";
$use "rfpc";



Var? (s.tag t.name), s.tag : \{ SVAR; TVAR; VVAR; EVAR; VAR; };


//***************************** Free indices. ******************************
//
//$table Free-Indices;
//
//
//$func Free-Index e.key = s.idx;
//
//Free-Index e.key, {
//  <Lookup &Free-Indices e.key> : s.idx = s.idx;
//  1;
//};
//
//
//$func Set-Index (e.key) s.idx = ;
//
//Set-Index (e.key) s.idx = <Bind &Free-Indices (e.key) (s.idx)>;


*************** Functions to deal with sets of variables. ****************

$box State;

Vars-Copy-State = <Box <? &State>>;

Vars-Set-State s.state = <Store &State <? s.state>>;


Init-Vars =
  <Store &State /*empty*/>;
//  <RFP-Clear-Table &Free-Indices>;



//! $func Create-Var e = e;

//! New-Vars e.vars = <Map &Create-Var (e.vars)> : e;

//! Create-Var t.var, t.var : {
//! 	(SVAR t.name) = <Put &State (t.var (SVAR) (1) (1) Non-Declared Non-Instantiated)>;
//! 	(TVAR t.name) = <Put &State (t.var (TVAR) (1) (1) Non-Declared Non-Instantiated)>;
//! 	(VVAR t.name) = <Put &State (t.var (VVAR) (1) ( ) Non-Declared Non-Instantiated)>;
//! 	(EVAR t.name) = <Put &State (t.var (EVAR) (0) ( ) Non-Declared Non-Instantiated)>;
//! 	( VAR t.name) = <Put &State (t.var (VAR)  (0) ( ) Non-Declared Non-Instantiated)>;
//! };

$func Normalize-Info e.info t.var = ;

Normalize-Info e.info t.var =
  /*
   * Если дана длина, приравнять к ней минимум и максимум.
   */
  {
    e.info : e (Length e.len) e =
      {
        e.info : e1 (Min e.min) e2 =
          {
            e.min : e.len = e.info;
            (Min e.len) e1 e2;
          };
        (Min e.len) e.info;
      } :: e.info,
      {
        e.info : e1 (Max e.max) e2 =
          {
            e.max : e.len = e.info;
            e1 e2 (Max e.len);
          };
        e.info (Max e.len);
      };
    e.info;
  } :: e.info,
  /*
   * Если минимум не установлен, установить его, исходя из типа переменной.
   */
  {
    e.info : e (Min e) e = e.info;
    t.var : {
      (SVAR e) = 1;
      (TVAR e) = 1;
      (VVAR e) = 1;
      (EVAR e) = 0;
      ( VAR e) = 0;
    } :: s.min =
      e.info (Min s.min);
  } :: e.info,
  /*
   * Для s- и t-переменных установить максимум, если не установлен.
   */
  {
    t.var : \{ (SVAR e); (TVAR e); } =
      {
        e.info : e (Max e) e = e.info;
        e.info (Max 1);
      };
    e.info;
  } :: e.info,
  /*
   * Если минимум совпадает с максимумом, то установить длину.
   * FIXME: не нужно ли здесь упрощать выражения для минимума и максимума?
   */
  {
    e.info : e (Length e) e = e.info;
    e.info : e (Max s.max) e, e.info : e (Min s.max) e = e.info (Length s.max);
    e.info;
  } :: e.info,
  /*
   * Если переменная получила значение, а длина её не была известна, значит
   * она будет считаться функцией LENGTH в ран-тайм.
   */
  {
    e.info : e (Length e) e = e.info;
    e.info : e (Instantiated? True) e = e.info (Length (LENGTH t.var));
    e.info;
  } :: e.info,
  /*
   * s-переменные помечаем как плоские.
   */
//  {
//    t.var : (SVAR e) =
//      {
//        e.info : e (Flat? e) e = e.info;
//        e.info (Flat? True);
//      };
//    e.info;
//  } :: e.info,
  <Put &State (t.var e.info)>;

Set-Var e.info t.var, {
  <? &State> : $r e1 (t.var e.old-info) e2 =
    e.old-info (e.info) (/*e.new-info*/) $iter {
      e.old-info : (t.key e.val) e.rest, {
        e.info : e3 (t.key e.new-val) e4 = e3 e4 (t.key e.new-val);
        e.info (t.key e.val);
      } :: e.info t.item =
        e.rest (e.info) (e.new-info t.item);
    } :: e.old-info (e.info) (e.new-info),
    e.old-info : /*empty*/ =
    <Store &State e1 e2>,
    e.info e.new-info t.var;
  e.info t.var;
} :: e.info t.var =
  <Normalize-Info e.info t.var>;

Get-Var t.key t.var,
  <? &State> : $r e1 (t.var e.info) e2 =
  {
    e.info : e (t.key e.val) e = e.val;
    /*empty*/;
  };

Set-Var- e.info t.var = <Set-Var e.info t.var>;


$func Print-Var e = e;

Vars-Print e.vars = <Map &Print-Var (e.vars)>;

Print-Var {
  (s.tag (e.name)) = (s.tag (<To-Word e.name>));
  (s.tag s.box)    = (s.tag s.box);
};



$func Decl-Var e = e;

Vars-Decl e.vars = <Map &Decl-Var (e.vars)>;


Decl-Var t.var, {
  <Get-Var Decl t.var> : s.box;
  <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
    <Set-Var (Decl s.decl) t.var>,
    (Declare s.decl);

//!	<? &State> : $r e1 (t.var tag t.min t.max s.decl e.rest) e2 =
//!		{
//!			<Box? s.decl> = s.decl;
//!			<Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
//!				<Store &State e1 (t.var tag t.min t.max s.decl e.rest) e2>,
//!				s.decl;
//!		} :: s.decl,
//!		(Declare s.decl);
//!
//!	<Create-Var t.var> : e, <Decl-Var t.var>;
};



Create-Int-Var (e.prefix) t.var e.expr, {
  t.var : Aux = (VAR <Box 0 e.prefix>);
  (VAR <Box 1 e.prefix t.var>);
} :: t.int-var =
  t.int-var (INT t.int-var e.expr); 



//!Declared? t.var =
//!	<? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>;


//!$func? Decl-Box t.var = s.box;

//!Decl-Box t.var =
//!	<? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>, s.decl;


//!Instantiated? t.var =
//! <Var? t.var>,
//! <? &State> : $r e (t.var tag t.min t.max s.decl s.inst) e = s.inst : Instantiated;


/*
 * Convert FORMAT to RESULT expression by giving a name to each format
 * variable. In FORMAT may meet normal variables, they are not changed.
 * Resulting expression is generated without pragmas, so it can't be used in
 * the abstract syntax.
 * Return all variables from generated expression and the expression.
 */
Gener-Vars (e.format) e.prefix =
*	<Gener-Var-Indices <Free-Index e.prefix> (e.format) e.prefix> :: e.Re s.max-index,
*	<Set-Index (e.prefix) s.max-index>,
*	<Del-Pragmas e.Re> :: e.Re,
  {
    e.format : (s.tag) e.Fe, {
      s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
        (s.tag <Box 0 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
      (s.tag <Box 1 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
    };
    e.format : (PAREN e1) e2 =
      (PAREN <Gener-Vars (e1) e.prefix>) <Gener-Vars (e2) e.prefix>;
    e.format : t.Ft e.Fe =
      t.Ft <Gener-Vars (e.Fe) e.prefix>;
    /*empty*/;
  };
*	<Vars e.Re> :: e.vars,
*	<New-Vars e.vars>,
*	(e.vars) e.Re;


Generated-Var? (s.tag s.box), s.tag : \{ EVAR; VVAR; TVAR; SVAR; };


Gener-Var-Assign t.var (s.tag s.box) =
  <Store s.box <Print-Var t.var>>,
  {
    <Get-Var Decl t.var> : s =
      <Get-Var Decl (s.tag s.box)> : s.decl-box,
      <Store s.decl-box /*empty*/>;;
  };


$box Var-Names;

$table Var-Indices;

$func Boxes-To-Vars e.expr-with-boxes = e.expr-with-var-names;

$func Gener-Name s.form-one? s.name = s.unique-name;


Gener-Var-Names expr =
  <Store &Var-Names /*empty*/>,
  <RFP-Clear-Table &Var-Indices>,
  <Boxes-To-Vars expr>;


Boxes-To-Vars {
  (s.tag s.box) expr, s.tag : \{ EVAR; VVAR; TVAR; SVAR; VAR; } =
    <? s.box> : {
      0 e.name =
        (VAR (<Gener-Name From-One <To-Word e.name>>)) :: t.var,
        <Store s.box t.var>,
        t.var <Boxes-To-Vars expr>;
      1 e.prefix t.var =
        <Boxes-To-Vars t.var> : (s (e.name)),
        (VAR (<Gener-Name From-Two <To-Word e.prefix e.name>>)) :: t.var,
        <Store s.box t.var>,
        t.var <Boxes-To-Vars expr>;
      t.var = <Boxes-To-Vars t.var expr>;
    };
  (Declare s.decl) expr = <Boxes-To-Vars <? s.decl> expr>;
  (e1) e2   = (<Boxes-To-Vars e1>) <Boxes-To-Vars e2>;
  term expr = term <Boxes-To-Vars expr>;
  /*empty*/ = /*empty*/;
};


Gener-Name s.form-one? s.name =
  {
    <Lookup &Var-Indices s.name>;
    0;
  } : s.idx,
  <"+" s.idx 1> :: s.idx,
  <Bind &Var-Indices (s.name) (s.idx)>,
  {
    # \{ s.form-one? : From-One; }, s.idx : 1 = /*empty*/;
    s.idx;
  } :: e.idx,
  <To-Word s.name e.idx> :: s.n,
  {
    <? &Var-Names> : $r e s.n e = <Gener-Name s.form-one? s.name>;
    <Put &Var-Names s.n>, s.n;
  };



/*
 * Generates indexes for all variables in e.Format and returns e.Format with all
 * (?VAR) changed to (?VAR (e.Name)) and s.max.
 * e.Name is all words from e.prefix plus unical number. Numbers are generated
 * sequentially starting with s.num.
 * s.max is the maximum of all generated numbers plus one.
 * All normal variables from e.Format are returned as they are.
 */
Gener-Var-Indices s.num (e.Format) e.prefix, {
  e.Format : t.Ft e.rest, t.Ft : {
    s.ObjectSymbol = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
    (REF e) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
    (PAREN e.Fe) =
      <Gener-Var-Indices s.num (e.Fe) e.prefix> :: expr s.num,
      (PAREN expr) <Gener-Var-Indices s.num (e.rest) e.prefix>;
    (s.VariableTag) =
      (VAR (PRAGMA) (e.prefix s.num)) :: t.var,
      <"+" s.num 1> :: s.num,
      t.var <Gener-Var-Indices s.num (e.rest) e.prefix>;
    (s.VariableTag e.Name) = t.Ft <Gener-Var-Indices s.num (e.rest) e.prefix>;
  };
  /*
   * e.Format is empty, so return s.num -- the last term in the answer.
   */
  s.num;
};



Strip-STVE expr = <Subst (SVAR TVAR VVAR EVAR) ((VAR) (VAR) (VAR) (VAR)) expr>;

Vars e.expr =
  e.expr () $iter {
    e.expr : t.first e.rest,
      t.first : {
        s.ObjectSymbol = /*empty*/;
        (REF t.Name) = /*empty*/; 
        (STATIC t.Name) = /*empty*/;
        (PAREN e.ResultExpression) = <Vars e.ResultExpression>;
        (CALL (PRAGMA (e) e) t.Fname e.ResultExpression) =
          <Vars e.ResultExpression>;
        (CALL t.Fname e.ResultExpression) = <Vars e.ResultExpression>;
        t.var = t.var;  // t.var ::= (EVAR t.Name) | (VVAR t.Name)
                //         | (TVAR t.Name) | (SVAR t.Name)
      } :: e.var =
      e.rest (e.vars e.var);
  } :: e.expr (e.vars),
  e.expr : /*empty*/ =
  e.vars;

Norm-Vars (e.vars) e.Snt =
  /*
   * Store all new variables in the &Vars-Tab table and return the list with
   * all variables in the (VAR t.name) form.
   */
  <Store-Vars e.vars> :: e.new-vars,
  /*
   * Rename all new variables in e.Snt. Never mind multiple occurences.
   */
  (e.vars) (e.new-vars) e.Snt $iter {
    e.vars : t.var e.rest, e.tmp-vars : t.new-var e.new-rest, {
      t.var : t.new-var =
        (e.rest) (e.new-rest) e.Snt;
      t.var : (s.tag e) =
        (e.rest) (e.new-rest) <Subst (t.var) ((t.new-var)) e.Snt>;
    };
  } :: (e.vars) (e.tmp-vars) e.Snt,
  e.vars : /*empty*/ =
  (e.new-vars) e.Snt;


$table Vars-Tab;

Store-Vars e.vars =
//  <WriteLN Store-Vars e.vars>,
  e.vars () $iter {
    e.vars : (s.var-tag (e.QualifiedName s.last)) e.rest,
      {
        s.last : 0 = (e.QualifiedName);
        <Int? s.last> = (e.QualifiedName s.last);
        /*empty*/ =
          s.var-tag : {
            SVAR = "s";
            TVAR = "t";
            VVAR = "v";
            EVAR = "e";
            VAR = /*empty*/;
          } :: e.var-sym,
          (e.var-sym e.QualifiedName s.last);
      } :: t.name,
      {
        <In-Table? &Vars-Tab t.name>; // do nothing
        <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
          s.var-tag : {
            SVAR =
              <Set-Var t.name (Min) (1)>,
              <Set-Var t.name (Max) (1)>,
              <Set-Var t.name (Length) (1)>,
              <Set-Var t.name (Flat) (True)>;
            TVAR =
              <Set-Var t.name (Min) (1)>,
              <Set-Var t.name (Max) (1)>,
              <Set-Var t.name (Length) (1)>;
            VVAR =
              <Set-Var t.name (Min) (1)>;
//              <Set-Var t.name (Max) ()>;
            EVAR =
              <Set-Var t.name (Min) (0)>;
//              <Set-Var t.name (Max) ()>;
            e = <WriteLN !-!-!-! t.name>,
              <Exit -1>;
          },
          <Set-Var t.name (Left-compare) ()>,
          <Set-Var t.name (Right-compare) ()>,
          <Set-Var t.name (Left-checks) ()>,
          <Set-Var t.name (Right-checks) ()>,
          <Set-Var t.name (Format) ((s.var-tag))>;
      },
      e.rest (e.new-vars (VAR t.name));
  } :: e.vars (e.new-vars),
  e.vars : /*empty*/ =
  e.new-vars;

Declare-Vars s.type e.vars =
  e.vars () $iter {
    e.vars : (VAR t.name) e.rest, {
      <?? t.name Declared> : True;  // do nothing
      {
        <In-Table? &Vars-Tab t.name>; // do nothing
        { s.type : Expr = <WriteLN Decl-Format t.name>;; },
        <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
          <Set-Var t.name (Left-compare) ()>,
          <Set-Var t.name (Right-compare) ()>,
          <Set-Var t.name (Left-checks) ()>,
          <Set-Var t.name (Right-checks) ()>,
//          <Set-Var t.name (Format) ((VAR t.name))>,
          <Set-Var t.name (Format) ((EVAR))>,
          <Set-Var t.name (Min) (0)>;
      },
        <Set-Var t.name (Declared) (True)>,
        (DECL s.type (VAR t.name));
    } :: e.new-decl,
    e.rest (e.decls e.new-decl);
  } :: e.vars (e.decls),
  e.vars : /*empty*/ =
  e.decls;

Instantiate-Vars e.vars =
  e.vars $iter {
    e.vars : (VAR t.name) e.rest,
      <Set-Var t.name (Instantiated) (True)>,
      e.rest;
  } :: e.vars,
  e.vars : /*empty*/;

?? t.name e.key =
  <Lookup &Vars-Tab t.name> : s.tab,
  <Lookup s.tab e.key>;

//!Set-Var t.name (e.key) (e.val) =
//  <WriteLN Set-Var t.name (e.key)>,
//!	<Lookup &Vars-Tab t.name> : s.tab,
//!	<Bind s.tab (e.key) (e.val)>;