///////////////////////////////////////////////////////////////////////////////
//                             Lisaac Compiler                               //
//                                                                           //
//                   LSIIT - ULP - CNRS - INRIA - FRANCE                     //
//                                                                           //
//   This program is free software: you can redistribute it and/or modify    //
//   it under the terms of the GNU General Public License as published by    //
//   the Free Software Foundation, either version 3 of the License, or       //
//   (at your option) any later version.                                     //
//                                                                           //
//   This program is distributed in the hope that it will be useful,         //
//   but WITHOUT ANY WARRANTY; without even the implied warranty of          //
//   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           //
//   GNU General Public License for more details.                            //
//                                                                           //
//   You should have received a copy of the GNU General Public License       //
//   along with this program.  If not, see <http://www.gnu.org/licenses/>.   //
//                                                                           //
//                     http://isaacproject.u-strasbg.fr/                     //
///////////////////////////////////////////////////////////////////////////////
Section Header
  
  + name        := ITM_BINARY;

  - copyright   := "2003-2007 Benoit Sonntag";

  
  - author      := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment     := "Binary operator message";
  
Section Inherit
  
  + parent_itm_code:Expanded ITM_CODE;
  
Section Public

  //
  // Data
  //

  + position_list:FAST_ARRAY[POSITION];

  + value_list   :FAST_ARRAY[ITM_CODE];

  + operator_list:FAST_ARRAY[STRING_CONSTANT];

  //
  // Constructor
  //  

  - create p:FAST_ARRAY[POSITION] values v:FAST_ARRAY[ITM_CODE] 
  operators o:FAST_ARRAY[STRING_CONSTANT] :SELF <-
  ( + result:SELF;
    result := clone;
    result.make p values v operators o;
    result
  );
  
  - make p:FAST_ARRAY[POSITION] values v:FAST_ARRAY[ITM_CODE] 
  operators o:FAST_ARRAY[STRING_CONSTANT] <-
  (
    ? { p.count=o.count };
    ? { p.count=(v.count-1) };
    position_list := p;
    value_list    := v;
    operator_list := o;
  );

  //
  // Runnable.
  //

  - to_run_expr:EXPR <-
  ( + max_pos,max_lev:INTEGER;
    + max_pri  :STRING_CONSTANT;
    + expr     :INSTR;
    + val_list:FAST_ARRAY[EXPR];
    + val:EXPR;    
    + typ_list:TYPES_TMP;
    + typ:TYPE;
    + slo_list:FAST_ARRAY[SLOT];
    + slo,slo_ref:SLOT;
    + ope_list:FAST_ARRAY[STRING_CONSTANT];
    + pos_list:FAST_ARRAY[POSITION];
    + nam:STRING_CONSTANT;
    + site:NODE;
    + extern:EXPR;
    + loc:VARIABLE;
    + l_arg:FAST_ARRAY[EXPR];
    + result:EXPR;

    // Array Temporary.
    ope_list := ALIAS_ARRAY[STRING_CONSTANT].new;
    ope_list.copy operator_list;
    pos_list := ALIAS_ARRAY[POSITION].new;
    pos_list.copy position_list;
    val_list := ALIAS_ARRAY[EXPR].new;
    typ_list := TYPES_TMP.new;
    slo_list := ALIAS_ARRAY[SLOT].new;

    // ITM_CODE -> EXPR
    (value_list.lower).to (value_list.upper) do { j:INTEGER;      
      val := value_list.item j.to_run_expr;      
      val_list.add_last val;
      typ := val.static_type.raw;      
      typ_list.add typ;
    };
                  
    // Error verification.      
    (operator_list.lower).to (operator_list.upper) do { j:INTEGER;
      nam := operator_list.item j;
      ((nam = ALIAS_STR.operator_equal) || {nam = ALIAS_STR.operator_not_equal}).if {
	// '=' or '!=':
	slo_list.add_last NULL;
      } else {
	// Other:
	typ := typ_list.first;
	slo_ref := typ.get_slot nam;
	(slo_ref = NULL).if {
	  error_slot (position_list.item j) name nam in typ list typ_list;
	} else {
	  slo_list.add_last slo_ref;
	  (typ_list.lower+1).to (typ_list.upper) do { k:INTEGER;
	    typ := typ_list.item k;
	    slo := typ.get_slot nam;
	    (slo = NULL).if {
	      error_slot (position_list.item j) name nam in typ list typ_list;
	    } else {
	      (slo_ref.priority_and_level != slo.priority_and_level).if {
		position.put_error semantic text 
		"Conflicting declaration associativity or priority.";
		slo_ref.position.put_position;
		slo.position.put_position;
		position_list.item j.put_position; 
		position.send_error;
	      };	      
	    };
	  };
	};
      };
    };

    // operator_list -> SW_READ.
    {slo_list.is_empty}.until_do {
      // Search max level.
      max_lev := -1;
      (slo_list.lower).to (slo_list.upper) do { j:INTEGER;
	slo := slo_list.item j;
	(slo = NULL).if {
	  // '=' or '!='.
	  (
	    (50 > max_lev) ||
	    {(50 = max_lev) && {max_pri = ALIAS_STR.keyword_right}}
	  ).if {
	    max_lev := 50;
	    max_pri := ALIAS_STR.keyword_right;
	    max_pos := j;
	  };
	} else {
	  // Other:
	  ( 
	    (slo.priority > max_lev) ||
	    {
	      (slo.priority = max_lev) && 
	      {slo.associativity = max_pri} && 
	      {max_pri = ALIAS_STR.keyword_right}
	    }
	  ).if {
	    max_lev := slo.priority;
	    max_pri := slo.associativity;
	    max_pos := j;
	  };
	};
      };
      // Test conflicting.
      (
	(max_pos < slo_list.upper) &&
	{slo_list.item (max_pos+1) != NULL} &&
	{slo_list.item (max_pos+1).priority = max_lev} &&
	{slo_list.item (max_pos+1).associativity != max_pri}
      ).if {
	warning_error ((pos_list.item max_pos),
	"Conflicting left/right priority."); 
      };
            
      (slo_list.item max_pos = NULL).if {
	// '=' or '!='.
	(ope_list.item max_pos = ALIAS_STR.operator_equal).if {
	  extern := EXPR_EQUAL.create (pos_list.item max_pos) with 
	  (val_list.item max_pos) and (val_list.item (max_pos+1));
	} else {
	  extern := EXPR_NOT_EQUAL.create (pos_list.item max_pos) with 
	  (val_list.item max_pos) and (val_list.item (max_pos+1));
	};	
	loc  := type_boolean.default.get_temporary (pos_list.item max_pos);
	expr := loc.write (pos_list.item max_pos) value extern; 
	list_current.add_last expr;
	val := loc.read (pos_list.item max_pos);
      } else {
	// SW_READ.
	l_arg := FAST_ARRAY[EXPR].create_with_capacity 2;
	l_arg.add_last (val_list.item max_pos);
	l_arg.add_last (val_list.item (max_pos + 1));
	
	site := NODE.new_read (pos_list.item max_pos) 
	slot     (slo_list.item max_pos)
	receiver (l_arg.first.my_copy)
	with     l_arg;	
	
	list_current.add_last site;
	val := site.result_expr;
      };
      
      // Delete operator.
      slo_list.remove max_pos;      
      ope_list.remove max_pos;      
      pos_list.remove max_pos;       
      val_list.remove (max_pos+1);
      //
      val_list.put val to max_pos;      
    };

    result := val_list.first;
    
    // Free Array Temporary.
    ALIAS_ARRAY[STRING_CONSTANT].free ope_list;    
    ALIAS_ARRAY[POSITION].free pos_list;    
    ALIAS_ARRAY[EXPR].free val_list;
    typ_list.free;
    ALIAS_ARRAY[SLOT].free slo_list;
    
    result
  );
  
Section Private  
  
  - error_slot p:POSITION name s:STRING_CONSTANT in t:TYPE list st:TYPES_TMP <-
  (
    string_tmp.copy "Slot '";
    string_tmp.append s;
    string_tmp.append "' not found in ";
    string_tmp.append (t.intern_name);
    string_tmp.append ". ( ";
    (st.lower).to (st.upper-1) do { j:INTEGER;
      st.item j.append_name_in string_tmp;
      string_tmp.add_last ' ';
    };
    st.last.append_name_in string_tmp;
    string_tmp.add_last ')';
    semantic_error (p,string_tmp);
  );




