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

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

  
  - author  := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment := "For local access variable or send message without argument";
  
  // BSBS: Optim: Penser à faire un ITM_READ_ARG3 pour tous les `if then else'
  
Section Inherit
  
  + parent_itm_code:Expanded ITM_CODE;
  
Section Public 
  
  - is_affect:POSITION; // Nothing (it's good with 0).
  
  //
  // Data
  //

  + name:STRING_CONSTANT;

  //
  // Constructor
  //

  - create p:POSITION name n:STRING_CONSTANT :SELF <-
  ( + result:SELF;
    result := clone;
    result.make p name n;
    result
  );
  
  - make p:POSITION name n:STRING_CONSTANT <-
  (
    position := p;
    name := n;
  );

  //
  // Runnable
  //
      
  - to_run_expr:EXPR <-
  ( + result:EXPR;
    + loc:LOCAL;    
            
    loc := lookup name;
    (loc != NULL).if {
      //
      // Local Access.
      //            
      (loc.style = '-').if {
	loc.set_ensure_count 1;
	name := loc.intern_name;
	result := to_run_with NULL args NULL;
      } else {
	result := loc.read position;
      };
    } else {
      //
      // Slot Access without argument.
      //      
      result := to_run_with NULL args NULL;
    };
    result
  );
  
Section ITM_READ  
  
  - to_run_with first_itm:ITM_CODE args larg:FAST_ARRAY[ITM_CODE] :EXPR <-
  ( + args:FAST_ARRAY[EXPR];
    + receiver:EXPR;
    + receiver_type:TYPE;
    + em:EXPR_MULTIPLE;
    + pos_null:POSITION;
    //
    + itm_list:ITM_LIST;
    + itm_read:ITM_READ;
    + is_resend:BOOLEAN;
    //    
    + slot_msg:SLOT;
    + is_block_value:BOOLEAN;
    //
    + base:NODE;
        
    //
    // Compute `receiver'.
    //    
    args := ALIAS_ARRAY[EXPR].new;
    (first_itm = NULL).if {
      // Implicite Self.
      receiver := lookup (ALIAS_STR.variable_self).read position;    
    } else {      
      receiver := first_itm.to_run_expr;      
      // Resend detect.
      itm_list ?= first_itm;
      (itm_list != NULL).if {
	itm_read ?= itm_list.code.first;
      } else {	
	itm_read ?= first_itm;
      };
      is_resend := (
	(itm_read != NULL) && 
	{position.prototype.search_parent (itm_read.name)}
      );
    };
    
    //
    // Detect slot.
    //
    
    receiver_type := receiver.static_type.raw;
    (receiver_type = TYPE_VOID).if {
      // BSBS: Ce cas ne doit jamais arriver !
      // il se déclenche avec parent.msg.truc lorsque msg du parent n'a pas de type de retour
      // Mais que le profil général en a un...
      semantic_error (position,"Call on Void"); 
    };
    
    ((receiver_type == type_block) && 
    {name = ALIAS_STR.slot_value}).if {
      // { ... }.value
      is_block_value := TRUE;
    } else {
      slot_msg := receiver_type.get_slot name;     
      (slot_msg = NULL).if {            
	string_tmp.copy "Slot `";
	string_tmp.append name;
	string_tmp.append "' not found in `";
	receiver_type.append_name_in string_tmp; 
	string_tmp.append "'.";
	semantic_error (position,string_tmp);
      };
      // For problem with block profil ! (Not clean...)                  
      (
	(slot_msg.slot_data_intern != NULL) && 
	{slot_msg.slot_data_intern.type.raw == type_block}
      ).if {
	slot_msg.slot_data.init; // BSBS: Ne doit plus etre necessaire, c est fait en amont.
      };
      // Verification
      (verify).if {
	(
	  ((larg  = NULL) && {slot_msg.base_slot.argument_list.count != 1}) || 
	  {(larg != NULL) && {larg.count != slot_msg.base_slot.argument_list.count-1}}
	).if {
	  POSITION.put_error semantic text "Incorrect number argument."; 
	  slot_msg.position.put_position;
	  position.put_position;
	  POSITION.send_error;
	};
	last_position := slot_msg.position;	
	( !
	  slot_msg.id_section.access receiver_type with (ITM_TYPE_SELF.to_run.raw)
	).if {
	  string_tmp.copy "Type ";
	  ITM_TYPE_SELF.to_run.append_name_in string_tmp;
	  string_tmp.append " does not have access to this slot.";
	  POSITION.put_error warning text string_tmp;
	  slot_msg.position.put_position;
	  position.put_position;
	  POSITION.send_error;
	};
	last_position := pos_null;
      };
    };
    //
    // Add arguments
    //
    add_arg receiver to 0 in args for slot_msg block is_block_value;
    em ?= receiver;
    (em != NULL).if {
      receiver := em.expr_list.first;
    };
    (larg != NULL).if {
      (larg.lower).to (larg.upper) do { j:INTEGER;
	add_arg (larg.item j.to_run_expr) to (j+1) in args for slot_msg block is_block_value;
      };
    };
            
    //
    // Send message.
    //
    (is_block_value).if {
      // { ... }.value      
      args := ALIAS_ARRAY[EXPR].copy args;      
      args.put (args.first.my_copy) to 0;      
      //receiver := slot_msg.slot_data_intern.read position with receiver;
      base := NODE.new_block position receiver receiver with args;
    }.elseif {args.count = 1} then {
      // Classic message without arguments.
      (is_resend).if {
	args.put (lookup (ALIAS_STR.variable_self).read position) to 0;
	args.first.remove;
      };
      
      ((verify) && {is_all_warning} && {name == "deferred"}).if {
	string_tmp.copy "Deferred in `";
	string_tmp.append (profil_first.slot.name);
	string_tmp.append "' for ";
	receiver.static_type.append_name_in string_tmp;	
	warning_error (position,string_tmp);
      };
      
      base := NODE.new_read position slot slot_msg receiver receiver self (args.first);
      
      ALIAS_ARRAY[EXPR].free args;
    } else {
      // Classic message with arguments.
      (is_resend).if {
	args.put (lookup (ALIAS_STR.variable_self).read position) to 0;	
      } else {
	args.put (args.first.my_copy) to 0;
      };
      args := ALIAS_ARRAY[EXPR].copy args;
      base := NODE.new_read position slot slot_msg receiver receiver with args;
    };
    list_current.add_last base;
        
    (larg != NULL).if {
      ALIAS_ARRAY[ITM_CODE].free larg;
    };
    
    ? {base.result_expr != NULL};
    base.result_expr    
  );
  
Section Private
  
  - add_arg e:EXPR to idx:INTEGER 
  in args:FAST_ARRAY[EXPR] for slot:SLOT block is_block_value:BOOLEAN <-
  ( + em:EXPR_MULTIPLE;
    + count:INTEGER;
    
    em ?= e;
    (em != NULL).if {
      count := em.cardinality;
      args.append_collection (em.expr_list);
    } else {
      count := 1;
      args.add_last e;
    };
    (verify).if {
      (! is_block_value).if {	
	(slot.base_slot.argument_list.item idx.count != count).if {
	  POSITION.put_error semantic text "Incorrect vector size."; 
	  slot.base_slot.argument_list.item idx.position.put_position;
	  e.position.put_position;
	  POSITION.send_error;
	};
      }.elseif {(idx = 0) && {count != 1}} then {
	semantic_error (e.position,"Incorrect vector size for `value' message.");
      };
    };
  );
  