///////////////////////////////////////////////////////////////////////////////
//                             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_WRITE_VALUE;

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

  
  - author      := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment     := "Write with a value";
  
Section Inherit
  
  + parent_itm_write:Expanded ITM_WRITE;
  
Section Public

  //
  // Runnable 
  //

  - to_run_expr:EXPR <-
  ( + ass_multiple:ITM_LIST_IDF;
    + val:EXPR;
    + val_multiple:EXPR_MULTIPLE;
    + j:INTEGER;
    + lst_idf:FAST_ARRAY[STRING_CONSTANT];
    + itm_read:ITM_READ;
    + lst_exp:FAST_ARRAY[EXPR];
    + result:EXPR;
        
    val := value.to_run_expr;
            
    val_multiple ?= val;
    (val_multiple != NULL).if {
      //
      // Assignment Vector.      
      //
      lst_exp := FAST_ARRAY[EXPR].create_with_capacity (val_multiple.count);
      ass_multiple ?= assign;
      (ass_multiple != NULL).if {	
	lst_idf := ass_multiple.list_name;
	(lst_idf.lower).to (lst_idf.upper-1) do { i:INTEGER;
	  j := affect (lst_idf.item i) with val_multiple index j in lst_exp;
	};	
	j := affect (lst_idf.last) with val_multiple index j in lst_exp;	
      } else {
	itm_read ?= assign;
	? {itm_read != NULL};
	j := affect (itm_read.name) with val_multiple index j in lst_exp;	
      };
      (j <= val_multiple.upper).if {
	semantic_error (position,"Incorrect size vector.");
      };
      result := EXPR_MULTIPLE.create lst_exp;
    } else {
      //
      // Assignment simple.
      //      
      itm_read ?= assign;
      ? {itm_read != NULL};      
      result := affect (itm_read.name) with val;
    };
    result
  );

Section Private
  
  - affect idf:STRING_CONSTANT with val:EXPR_MULTIPLE 
  index n:INTEGER in lst:FAST_ARRAY[EXPR] :INTEGER <-
  ( + loc:LOCAL;
    + result:INTEGER;
    + slot:SLOT;
    + typ_multi:ITM_TYPE_MULTI;
    + lst_expr:FAST_ARRAY[EXPR];
    
    (n > val.upper).if {
      semantic_error (position,"Incorrect size vector.");
    };
    
    loc := lookup idf;
    (loc != NULL).if {      
      lst.add_last (affect_local loc with (val.item n));
      result := n + 1;
    } else {
      slot := ITM_TYPE_SELF.to_run.get_slot idf;
      (slot = NULL).if {
	string_tmp.copy "Slot `";
	string_tmp.append idf;
	string_tmp.append "' not found in static type ";
	ITM_TYPE_SELF.to_run.append_name_in string_tmp;
	string_tmp.add_last '.';
	semantic_error (position,string_tmp);
      };
      typ_multi ?= slot.base_slot.type;
      (typ_multi != NULL).if {
	result := n + typ_multi.count;
	(result > val.count).if {
	  semantic_error (position,"Incorrect size vector.");
	};
	//BSBS: Recycle les EXPR_MULTIPLE
	lst_expr := FAST_ARRAY[EXPR].create_with_capacity (typ_multi.count);	
	0.to (typ_multi.upper) do { i:INTEGER;
	  lst_expr.add_last (val.item (n+i));
	};	
	lst.add_last (affect_slot idf with (EXPR_MULTIPLE.create lst_expr));
      } else {
	lst.add_last (affect_slot idf with (val.item n));
	result := n + 1;
      };
    };
    result
  );