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

$use Access Arithm Box List StdIO Table;

$use "rfp_helper";


/*
 * Во время компиляции каждого модуля все статические константые выражения
 * складываются в ящик
 */
$box Static;
/*
 * Каждое выражение представлено термом вида (t.name expr).
 */



Init-Consts = <Store &Static /*empty*/>;



Create-Static {
  /*empty*/ = /*empty*/;
  (REF t.name) = (REF t.name);
  expr = {
    <? &Static> : e (t.name expr) e =
      (STATIC t.name);	// FIXME: Add comment?
    (<Length <? &Static>>) :: t.name,
      <Put &Static (t.name expr)>,
      (STATIC t.name);
  };
};



Get-Static (STATIC t.name), <? &Static> : e (t.name expr) e = expr;



/*
 * Накопленные в процессе компиляции модуля константные выражения лежат в
 * &Static.  Теперь необходимо отобразить их в CONSTEXPR из ASAIL.
 * Эта форма имеет следующий синтаксис:
 *
 * t.const         ::= (CONSTEXPR s.linkage t.name (e.comment) e.const-expr)
 * s.linkage       ::= EXPORT | LOCAL
 * t.name          ::= t.QualifiedName | (STATIC t.QualifiedName)
 * e.const-expr    ::= e.compound-expr | e.subexpr
 * e.compound-expr ::= [empty] | t.const-term e.const-expr
 * t.const-term    ::= s.symbol | (PAREN e.const-expr)
 *                              | (REF t.QualifiedName)
 *                              | (STATIC t.QualifiedName)
 * e.subexpr       ::= (SUBEXPR t.name s.pos s.len)
 * s.pos, s.len    ::= [int]
 *
 * e.comment содержит выражение в том виде, в котором оно встретилось в
 * Рефал-программе.  Может быть полезным для получения более читабельной
 * программы на императивном языке.
 *
 * REF -- ссылка на $const'анту или объект.
 *
 * STATIC -- обозначение константного статического выражения.
 *
 *
 * Выражения из &Static должны создаваться после того, как объявлены все
 * функции, объекты и константы, потому что могут ссылаться на них.
 * Они также ссылаются друг на друга, с целью минимизации ресурсов, требуемых
 * на их хранение.  Если выражение встречается как подвыражение в другом, то
 * оно должно являться просто ссылкой.  Несколько примеров того, как надо
 * заводить константы с учётом этого правила:
 *
 * 1. ABCD, ABC            --> ABC должно заводиться после ABCD, как подвыражение.
 *
 * 2. A(BCD)E, BC          --> BCD, затем A(BCD)E, затем BC, как подвыражение BCD.
 *
 * 3. A(BC(DE)FG)H, E      --> DE, затем A(BC(DE)FG)H, затем E.
 *
 * 4. A(BC(DE)FG)H, C(DE)F --> BC(DE)FG, затем A(BC(DE)FG)H, затем C(DE)F.
 *
 * 5. (AB)(ABC)(BC)        --> ABC, затем (AB)(ABC)(BC), причём AB и BC -- ссылки на ABC.
 *
 *
 * Итак, если из двух имеющихся выражений одно является подвыражением другого,
 * то первым делом заводится минимальное выражение в скобках, содержащее
 * подвыражение, а искомые выражения получаются из него либо операцией SUBEXPR,
 * либо одеванием скобок и конкатенацией.
 *
 * Для каждого подвыражения в скобках: если оно является подвыражением верхнего
 * уровня какого-нибудь другого выражения или подвыражения в скобках, то
 * сначала заводится выражение, содержащее его на верхнем уровне.
 *
 *
 * Обеспечивать такую схему будем в два приёма.  Сначала выпишем все выражения,
 * которые необходимо завести, а затем определим порядок их заведения,
 * удовлетворяющий зависимостям между ними.
 *
 * На первом шаге все статические выражения, и все их подвыражения в скобках
 * выписываются в табличку
 */
$table St-Table;
/*
 * Ключами являются сами выражения.  Значения имеют следующий вид:
 *
 * e.value ::= t.expr-name (e.context) (e.position)
 * t.expr-name ::= () | ([int])
 * e.context ::= expr
 * e.position ::= [empty] | s.pos s.len expr
 *
 * Пустое имя означает, что это выражение вспомогательное, нужное для
 * обеспечения выше приведённых правил, и нормальное имя для него будет
 * необходимо сгенерировать в случае, если его действительно потребуется
 * завести.
 *
 * e.context -- это уровень в объемлющем выражении, содержащий наше.  Например,
 * если наше выражение -- это A B, входящее в X (Y (A B) (Z (Z))) X, то
 * контекстом будет Y (A B) (Z (Z)).  Это поле нужно для определения выражений,
 * которые всегда используются в одном и том же контексте и, следовательно, не
 * требуют заведения.  Пустой контекст означает, что выражение используется в
 * разных ситуациях.  Выражение необходимо завести тогда и только тогда, когда
 * контекст пуст.
 *
 * e.position -- это координаты для тех выражений, которые являются
 * подвыражениями каких-либо других.  Такие выражения необходимо заводить после
 * тех, на которые они ссылаются.
 *
 * 
 * Опишем рекурсивный алгоритм раскладывания очередного выражения по табличке.
 */
$func Bind-Subexprs s.new? t.expr-name (e.context) (e.current) expr = s.new?;
/*
 * Будем искать подвыражения среди уже имеющихся в табличке, начиная с самых
 * глубоких.  Если на каком-то уровне окажется, что такого подвыражения в
 * табличке ещё не было (оно новое), значит там нет и никакого подвыражения
 * более высокого уровня.  Эту информацию будем хранить в s.new?, и она поможет
 * нам сэкономить на просмотрах имеющейся таблицы.
 *
 * Если s.new? есть Old, значит есть вероятность, что текущее выражение в
 * табличке уже имеется.  Если New, значит текущее выражение новое, в табличке
 * его точно нет.
 *
 * Возвращает функция также флаг s.new?, показывающий удалось ли найти текущий
 * уровень в табличке, и надо ли, соответственно, искать там следующий уровень.
 *
 * e.context -- контекст текущего уровня.
 *
 * e.current -- текущий уровень.
 *
 * expr -- остаток текущего уровня, который надо просмотреть на предмет
 * подвыражений.
 *
 * Для проверки того, что выражение e1 является подвыражением в скобках для
 * выражения e2 (откуда следует, что e1 не может быть заведено после e2), далее
 * используется функция
 */
$func? Subexpr? (e1) e2 = ;

Subexpr? (e1) e2, \{
  e1 : e2;
  e2 : e3 (PAREN e4) e5, <Subexpr? (e1) e4>;
};

Bind-Subexprs s.new? (e.name) (e.context) (e.current) expr, {
  /*
   * Прежде всего, заносим в таблицу все подвыражения.  Если какого-то из них
   * в таблице не оказалось, значит там нет и текущего выражения.
   */
  expr : e1 (PAREN e2) e3 =
    <Bind-Subexprs
      <Bind-Subexprs Old () (e.current) (e2) e2> (e.name) (e.context) (e.current) e3>;
  /*
   * Если все подвыражения оказались в таблице, значит там может оказаться и
   * весь текущий уровень.
   * Если его контекст уже пуст, значит он таким и остаётся.
   * Если он совпадает с текущим контекстом, опять всё остаётся как было.
   * Если же контекст раньше был иным, значит текущее подвыражение необходимо
   * заводить.  Его контекст обнуляется.  И мы можем не искать в таблице
   * следующий уровень (ведь единственный возможный оказался не совпадающим с
   * контекстом), поэтому возвращаем New.
   */
  s.new? : Old, <Lookup &St-Table e.current> : (e.tbl-name) (e.tbl-context) t.tbl-pos =
    {
      e.tbl-name : /*empty*/ = e.name;
      e.tbl-name;
    } :: e.tbl-name,
    {
      e.tbl-context : /*empty*/ = e.tbl-context Old;
      e.tbl-context : e.context = e.tbl-context Old;
      /*empty*/ New;
    } :: e.tbl-context s.new?,
    <Bind &St-Table (e.current) ((e.tbl-name) (e.tbl-context) t.tbl-pos)>,
    s.new?;
  /*
   * Если известно, что текущего уровня в таблице ещё нет, надо искать в ней
   * его подвыражения.  Если хотя бы одно такое подвыражение нашлось, значит
   * текущий уровень необходимо заводить.  Это контролирует флаг s.needed?.
   *
   * Однако возможна ситуация, когда найденое подвыражение необходимо для
   * заведения текущего.  Это проверяется функцией Subexpr?.  Если она не
   * $fail'ится, значит подвыражение необходимо для построения текущего
   * уровня и, следовательно, его нельзя заводить вырезанием из него.
   * 
   * Также, текущий уровень может оказаться подвыражением какого-либо
   * имеющегося выражения.   Тогда это выражение должно быть заведено,
   * поэтому его контекст обнуляется.  Позиция текущего уровня в этом
   * выражении запоминается в t.pos.
   * Если про текущее выражение известно, чо оно новое, то такой ситуации
   * быть не может.
   */
  <Domain &St-Table> Not-Needed () $iter {
    e.domain : (e.key) e.rest, {
      <Lookup &St-Table e.key> : e.tbl-params (),
        e.current : e1 e.key e2,
        # <Subexpr? (e.key) e.current> =
        <Bind &St-Table (e.key)
          (e.tbl-params (<Length e1> <Length e.key> e.current))>,
        e.rest Needed t.pos;
      s.new? : Old, t.pos : (), e.key : e1 e.current e2 =
        <Lookup &St-Table e.key> : t.tbl-name t.tbl-context t.tbl-pos,
        <Bind &St-Table (e.key) (t.tbl-name () t.tbl-pos)>,
        e.rest s.needed? (<Length e1> <Length e.current> e.key);
      e.rest s.needed? t.pos;
    };
  } :: e.domain s.needed? t.pos,
    e.domain : /*empty*/ =
    {
      s.needed? : Needed = /*empty*/;
      e.context;
    } :: e.context,
    <Bind &St-Table (e.current) ((e.name) (e.context) t.pos)>,
    New;
};

/*
 * Выражение из &Static кладётся в таблицу с помощью функции:
 */
$func Bind-Static e = e;

Bind-Static (t.name expr) = <Bind-Subexprs Old t.name () (expr) expr> : e;

/*
 * Теперь перейдём ко второму этапу -- составлению списка нужных выражений в
 * виде форм CONSTEXPR.
 *
 * Для заведения новых имён нам понадобиться свободный индекс.
 */
$box FreeIdx;
/*
 * Функция
 */
$func Name e.idx = t.name;
/*
 * Получает индекс -- тогда она делает имя из него, либо пустое выражение --
 * тогда она генерирует незанятый индекс, после чего делает из него имя.
 */
Name {
  /*empty*/ =
    <? &FreeIdx> : s.free,
    <Store &FreeIdx <"+" s.free 1>>,
    (STATIC (s.free));
  s.idx =
    (STATIC (s.idx));
};

/*
 * Функция
 */
$func Subexprs-To-Constexprs expr = (e.constexprs) e.const-expr-or-its-name;
/*
 * Возвращает список всех форм CONSTEXPR, которые нужны для заведения выражения
 * expr (т.е. форму, соответствующую expr, а также все, на которые она
 * ссылается, и которые не были заведены раньше).  Если expr необходимо
 * заводить как именованное выражение, то его форма включается в e.constexprs и
 * вторым параметром возвращается сгенерированное имя.  Иначе, второй
 * параметр -- это форма, соответствующая expr.
 *
 * Заведённые выражения помечаются как Constructed в таблице &St-Table.
 *
 * На случай, если пустое выражение попало в табличку, обрабатываем его
 * отдельно.
 */
Subexprs-To-Constexprs {
  /*empty*/ = () /*empty*/;
  expr, <Lookup &St-Table expr> : {
    Constructed e.const = () e.const;
    (e.name) (e.context) (e.pos) =
      {
        e.pos : s.left s.len e.source =
          <Subexprs-To-Constexprs e.source> :: (e.constexprs) e.source,
          (e.constexprs) (SUBEXPR e.source s.left s.len);
        expr () () $iter {
          expr : e1 (PAREN e2) e3 =
            <Subexprs-To-Constexprs e2> :: (e2-consts) e2,
            e3 (e.constexprs e2-consts) (e.const e1 (PAREN e2));
          /*empty*/ (e.constexprs) (e.const expr);
        } :: expr (e.constexprs) (e.const),
          expr : /*empty*/ =
          (e.constexprs) e.const;
      } :: (e.constexprs) e.const,
      {
        e.context : /*empty*/ =
          <Name e.name> :: t.name,
          (e.constexprs (CONSTEXPR LOCAL t.name (expr) e.const)) t.name;
        (e.constexprs) e.const;
      } :: (e.constexprs) e.const,
      <Bind &St-Table (expr) (Constructed e.const)>,
      (e.constexprs) e.const;
  };
};

/*
 * Выражение из &Static преобразуется в список CONSTEXPR-форм (для него, и всех
 * необходимых ему) с помощью функции:
 */
$func Static-To-Constexprs e.static-expr = e.constexprs;

Static-To-Constexprs (t.name expr) =
  <Subexprs-To-Constexprs expr> :: (e.constexprs) e = e.constexprs;

/*
 * Теперь, проинициализировав таблицу и свободный индекс, мы можем
 * сгенерировать список всех CONSTEXPR-форм.
 */
Comp-Consts =
  <RFP-Clear-Table &St-Table>,
  <Store &FreeIdx <Length <? &Static>>>,
  <Map &Bind-Static (<? &Static>)> : e,
  <Map &Static-To-Constexprs (<? &Static>)>;// : e,
//  {
//    <Domain &St-Table> : e (e.key) e,
//      <WriteLN e.key '--->' <Lookup &St-Table e.key>>,
//      $fail;;
//  };



* /*
*  * После того, как все нужные объекты скомпилированы, в &Static находится
*  * список всех используемых в них статических выражений и констант.  Необходимо
*  * для каждого выражения завести переменную (все переменные, кроме
*  * экспортируемых констант должны быть статическими).
*  *
*  * В ASAIL эти переменные представляются так:
*  *
*  * t.const      ::= (CONSTEXPR s.linkage t.name (e.comment) e.const-expr)
*  * s.linkage    ::= STATIC | EXTERN
*  * e.const-expr ::= [empty] | t.path | t.const-term e.const-expr
*  * t.const-term ::= s.symbol | (PAREN e.const-expr)
*  * t.path       ::= (PATH t.ref-name e.path-expr)
*  * e.path-expr  ::= (L s.pos) e.path-expr | (E s.pos s.len)
*  * s.pos, s.len ::= [int]
*  *
*  * e.comment содержит выражение в том виде, в котором оно встретилось в
*  * Рефал-программе.  Может быть полезным для получения более читабельной
*  * программы на императивном языке.
*  *
*  * t.path необходим для минимизации ресурсов, расходуемых на заведение
*  * констант.  Эта часть ASAIL (и соответствующая часть компилятора) является
*  * сугубо специфичной для векторного представления выражений с подвешенными
*  * скобками.  Для спискового ран-тайма такое представление констант будет
*  * вопиюще неэффективным.
*  * FIXME: возможно, стоит вынести представление констант за ASAIL.  Оставить в
*  * нём просто список всех употреблённых в программе константных выражений с
*  * именами, и предоставить бек-энду разбираться с их представлением.
*  * Тогда все нижеследующие функции, начиная с Compile-Static переедут в rfp_asail.
*  *
*  * t.path представляет из себя ссылку на подвыражение ранее определённого
*  * выражения t.ref-name.  Эта ссылка формирует либо новое выражение целиком,
*  * либо его часть, подвешенную в скобках.
*  *
*  * Ссылка строится по следующим правилам: сначала идёт несколько (м.б. ни
*  * одного) термов вида (L s.pos) (от слов Left, Length), означающих, что надо
*  * залезть в скобки, находящиеся на расстоянии s.pos от начала текущего уровня
*  * (считая слева); затем идёт ровно один терм (E s.pos s.len) (от слов Expr,
*  * End), означающий, что искомое подвыражение начинается в позиции s.pos
*  * текущего уровня, и имеет длину s.len.
*  *
*  * Основная функция, обрабатывающая &Static, и выдающая список констант в
*  * описанном выше виде:
*  */
* $func Compile-Static = e.asail-const-expressions;
* /*
*  * Она берёт выражения из &Static и по одному добавляет их к списку уже
*  * обработанных, нужным образом модифицируя этот список.
*  *
*  * Функция, добавляющая одно выражение к списку, называется
*  * $func Add-Static-Expr (t.name e.expr) e.static-exprs = e.new-static-exprs
*  */
* $func Add-Static-Expr e = e;
* /*
*  * В списке обработанных выражений (e.static-exprs) каждое выражение "помнит" о
*  * всех своих подвыражениях, которые надо завести.  К списку констант его
*  * преобразует функция
*  */
* $func Static-To-Const-Exprs e.static-exprs = e.asail-const-expressions;
* /*
*  * Для каждого выражения, она обрабатывает все его подвыражения непосредственно
*  * за ним.  Так как одно и то же выражение может быть подвыражением нескольких
*  * других выражений, необходимо помнить имена уже полученных констант, чтобы не
*  * завести какую-нибудь константу несколько раз.  Для этого имена обработанных
*  * выражений складываются в ящик
*  */
* $box Const-Exprs;
* 
* Compile-Static =
* 	<Foldr &Add-Static-Expr () (<? &Static>)> :: e.static-exprs,
* 	<WriteLN e.static-exprs>,
* 	<Store &Const-Exprs /*empty*/>,
* 	<WriteLN <Static-To-Const-Exprs e.static-exprs>>;
* /*
*  * Список e.static-exprs состоит из термов вида
*  * (t.expr-name (e.subexprs) e.expr), где e.expr -- обычное выражение,
*  * состоящее из символов, ссылок и скобок, в начале каждого уровня которого
*  * может идти терм (S e.labels), где
*  * e.labels ::= [empty] | t.label
*  * t.label  ::= (t.name s.pos s.len)
*  *
*  * e.subexprs -- список _обычных_ (без S-термов) выражений, имена которых
*  * встречаются в e.labels в e.expr.
*  *
*  * Для того, чтобы определить, является ли данное _обычное_ выржение ey
*  * подвыражением _статического_ (с S-термами) выражения ex есть функция:
*  */
* $func? Subexpr? (ex) (ey) t.y-name = e.x-with-ey-label;
* /* 
*  * Она ищет в ex уровень, подвыражением которого является ey, и вставляет в
*  * начало этого уровня соответствующую метку.  Если ey не является
*  * подвыражением ex, то функция выдаёт $fail.
*  */
* Subexpr? (ex) (ey) t.name =
* 	{
* 		ex : (S e.labels) e.xe = (e.labels) e.xe;
* 		() ex;
* 	} :: (e.labels) ex,
* 	{
* 		ex : e1 ey e2 = (S e.labels (t.name <Length e1> <Length e.y>)) e.x;
* 		ex : e1 (PAREN ez) e2 = (S e.labels) e1 (PAREN <Subexpr? (ez) (ey) t.name>) e2;
* 		= $fail;
* 	};
* /*
*  * Функция
*  */
* $func Find-Subexprs (ey) exprs = (e.y-with-labels) (e.subexprs) e.not-subexprs;
* /*
*  * берёт выражение ey (в общем случае _статическое_) и список _обычных_
*  * выражений exprs.
*  * Она находит в ey все подвыражения из exprs, вставляет в него соответствующие
*  * e.labels, и возвращает полученное ey, список выражений из exprs, являющихся
*  * подвыражениями ey, и список остальных выражений из exprs.
*  */
* Find-Subexprs {
* 	(ey) (t.xn ex) e.rest, {
* 		<Find-Subexprs (<Subexpr? (ey) (ex) t.xn>) e.rest> :: (ey) (e.subexprs) e.not-sub =
* 			(ey) ((t.xn ex) e.subexprs) e.not-sub;
* 		<Find-Subexprs (ey) e.rest> :: (ey) (e.subexprs) e.not-sub =
* 			(ey) (e.subexprs) (t.xn ex) e.not-sub;
* 	};
* 	(ey) /*empty*/ = (ey) () /*empty*/;
* };
* /*
*  * Для того, чтобы добавить выражение из &Static к списку e.static-exprs,
*  * необходимо произвести следующие действия:
*  *
*  * 1) Проверить, не является ли данное выражение подвыражением какого-либо из
*  *    уже имеющихся в списке.  Подвыражения хранятся в списке правее, чем их
*  *    хозяева, поэтому проверять надо справа на лево.
*  * 2) Пусть нашлось выражение ex, содержащее наше.  Никакое из уже имеющихся
*  *    его подвыражений наше не содержит.  Остаётся проверить, не содержит ли
*  *    наше выражение какие-нибудь из них.  После этого подвыражениями ex
*  *    являются только выражения, не являющиеся подвыражениями нашего, и само
*  *    наше выражение.  Добавляем в список наше выражение сразу после ex.
*  * 3) Если наше выражение не является подвыражением никакого из имеющихся, надо
*  *    проверить, какие выражения являются подвыражениями нашего.  Для этого
*  *    нужна их "чистая" форма (без S-термов).  Она берётся заново из &Static.
*  *    Т.к. Add-Static-Expr применяется в Compile-Static посредством Foldr, и на
*  *    каждое обрабатываемое выражение в e.static-exprs заводится ровно один
*  *    терм, нужные нам выражения лежат в правом конце &Static, и их кол-во
*  *    равняется длине имеющегося на данный момент списка. 
*  */
* Add-Static-Expr (t.yn ey) exprs, {
* 	exprs : $r e1 (t.xn (e.subexprs) ex) e2,
* 		<Subexpr? (ex) (ey) t.yn> :: ex =
* 		<Find-Subexprs (ey) e.subexprs> :: (e.y-expr) (e.y-subexprs) e.subexprs,
* 		e1 (t.xn (e.subexprs (t.yn ey)) ex) (t.yn (e.y-subexprs) e.y-expr) e2;
* 	<Find-Subexprs (ey) <Right 0 <Length exprs> <? &Static>>> :: (ey) (e.subexprs) e =
* 		(t.yn (e.subexprs) ey) exprs;
* };
* /*
*  * 
*  * 
*  */
* Static-To-Const-Exprs {
* 	(t.name t expr) e.rest =
* 		{
* 			t.name : (Extern t.n) = Extern t.n;
* 			Static t.name;
* 		} :: s.linkage t.name,
* 		<Subexprs-To-Const () (t.name) expr> :: expr (e.subexprs),
* 		{
* 			<? &Const-Exprs> : e t.name e = e.subexprs;
* 			<Put &Const-Exprs t.name>, (CONSTEXPR s.linkage t.name expr) e.subexprs;
* 	} :: e.const-exprs =
* 		e.const-exprs <Static-To-Const-Exprs e.rest>;
* 	/*empty*/ = /*empty*/;
* };
* 
* 
* 
* $func Labels-To-Const (e.path) e.labels = e.const-exprs;
* 
* Labels-To-Const (e.path) e.labels, e.labels : {
* 	(t.name s.pos s.len) e.rest =
* 		{
* 			t.name : (Extern t.n) = Extern t.n;
* 			Static t.name;
* 		} :: s.linkage t.name,
* 		{
* 			<? &Const-Exprs> : e t.name e;
* 			<Put &Const-Exprs t.name>,
* 				(CONSTEXPR s.linkage t.name (PATH e.path (E s.pos s.len)));
* 		} :: e.const-expr,
* 		e.const-expr <Labels-To-Const (e.path) e.rest>;
* 	/*empty*/ = /*empty*/;
* };
* 
* $func Subexprs-To-Const (e.subexprs) (e.path) expr = e.const-expr (e.const-subexprs);
* 
* Subexprs-To-Const (e.subexprs) (e.path) expr =
* 	{
* 		expr : (S e.labels) ex = (<Labels-To-Const (e.path) e.labels>) ex;
* 		() expr;
* 	} :: (e.sub) ex,
* 	ex (/*e.const*/) (e.subexprs e.sub) $iter {
* 		ex : e1 (PAREN e2) e3 =
* 			<Subexprs-To-Const (e.subexprs) (e.path (L <Length e1>)) e2> :: e2 (e.subexprs),
* 			e3 (e.const e1 (PAREN e2)) (e.subexprs);
* 		/*empty*/ (e.const ex) (e.subexprs);
* 	} :: ex (e.const) (e.subexprs),
* 	ex : /*empty*/ =
* 	e.const (e.subexprs);