///////////////////////////////////////////////////////////////////////////////
//                             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    := PROFIL_BLOCK;

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

  
  - author  := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment := "Method with costumization";
  
Section Inherit
  
  + parent_profil:Expanded PROFIL; 
  
  + parent_type:Expanded TYPE;
  
Section Public
  
  - slot:SLOT <- 
  (
    crash_with_message "PROFIL_BLOCK.slot";
    NULL
  );
  
  - type_c:STRING_CONSTANT <- "__BLOCK";
  
  + slot_self:SLOT_DATA;
  + slot_value:SLOT_DATA;
  
  - inc_id <-
  (
    slot_value.set_ensure_count (slot_value.ensure_count + 1);
  );
  
  - dec_id <-
  (
    slot_value.set_ensure_count (slot_value.ensure_count - 1);
    ? {slot_value.ensure_count >= 0};
  );  
  
  + context_extern:LOCAL;
  
  + profil_list:FAST_ARRAY[PROFIL_SLOT];
  + node_list:LINKED_LIST[NODE_TYPE];
    
  - is_context_sensitive:BOOLEAN <- context_extern != NULL;
  
  //
  // Creation.
  //
    
  - create base:ITM_BLOCK :SELF <-
  ( + result:SELF;
        
    result := clone;
    result.make base;
    result
  );
  
  - make base:ITM_BLOCK <-
  ( + list:ITM_LIST;
    + old_node_list:LINKED_LIST[NODE_TYPE];
    + var:LOCAL;
    
    list := base.list;
        
    PROFIL_LIST.add Self;
    type_self   := ITM_TYPE_SELF.to_run; 
    default := TYPE_FULL.create Self with (TYPE_FULL.expanded_bit | TYPE_FULL.default_expanded_bit);
    //           
    slot_self  := SLOT_DATA.clone;
    slot_self.make (list.position) name (ALIAS_STR.slot_self) style '+' base NULL type type_self;
    slot_self.set_intern_name (ALIAS_STR.slot_self);
    //
    slot_value := SLOT_DATA.clone;
    slot_value.make (list.position) name (ALIAS_STR.slot_id) style '+' base NULL type default;
    slot_value.set_intern_name (ALIAS_STR.slot_id);
    //
    profil_list := FAST_ARRAY[PROFIL_SLOT].create_with_capacity 2;    
    node_list   := LINKED_LIST[NODE_TYPE].create;
    old_node_list := NODE.node_list;
    NODE.set_node_list node_list;
        
    // index TYPE
    index       := index_count;
    index_count := index_count + 1;
    //default := TYPE_FULL.create Self with 0; 
    
    // Name : value
    name := ALIAS_STR.get_intern (ALIAS_STR.slot_value);    
    
    // Create code.    
    context := CONTEXT.push_block (list.position) profil Self;        
    
    // Append arguments.    
    (base.argument != NULL).if {      
      argument_list := FAST_ARRAY[LOCAL].create_with_capacity (base.argument.count+1);            
      argument_list.add_last NULL;
      base.argument.to_run argument_list;      
    } else {
      argument_list := FAST_ARRAY[LOCAL].create 1; 
    };   
    var := LOCAL.create (list.position) name (ALIAS_STR.variable_self) style ' ' type type_self;
    argument_list.put var to 0;
    (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
      stack_local.add_last (argument_list.item j);
    };
    //
    code := list_current;    
    //
    list.to_run_base TRUE;    
    //
    result_list := list.create_result_list;
    (list_current.static_type.raw != TYPE_VOID).if {
      result_last := list_current.static_type.get_temporary (list_current.position);      
    };
    context_extern := ITM_OBJECT.context_extern;
    //
    CONTEXT.pop_block;                
    NODE.set_node_list old_node_list;    
  );
  
  //
  // Genere Profil.
  //
  
  - is_static:BOOLEAN <- TRUE;
  
  - genere_handler buffer:STRING <-
  (
    (is_context_sensitive).if {
      warning_error (code.position,
	"Compiler limit : This block is context sensitive, and \
	\evaluation too far away from the context."
      );      
    };
    parent_profil.genere_handler buffer;
  );
  
  //
  // TYPE BLOCK.
  //
  
  - write_argument args:FAST_ARRAY[EXPR] :FAST_ARRAY[WRITE] <-
  ( + rd:READ;
    + rec:EXPR;
    
    rec := args.first;
    rd := slot_self.read (rec.position) with rec;
    args.put rd to 0;
    parent_profil.write_argument args
  );
  
  - set_late_binding <-
  (    
    type_block.set_late_binding;
  );
  
  - link <-
  ( 
    (link_count = 0).if {
      NODE.node_list.append_collection node_list;
    };
    link_count := link_count + 1;
  );
  
  - get_expr_result:EXPR <-
  ( + result:EXPR;
    + lst:FAST_ARRAY[EXPR];
    + loc:LOCAL;
        
    (result_list != NULL).if {
      lst := FAST_ARRAY[EXPR].create_with_capacity (result_list.count + 1);      
      (result_list.lower).to (result_list.upper) do { k:INTEGER;
	loc := result_list.item k;
	lst.add_last (loc.type.get_temporary_expr (loc.position));
      };
      loc := result_last;
      lst.add_last (loc.type.get_temporary_expr (loc.position));
      result := EXPR_MULTIPLE.create lst;      
    }.elseif {result_last != NULL} then {	
      loc := result_last;
      result := loc.type.get_temporary_expr (loc.position);
    } else {
      result := PROTOTYPE_CST.create (code.position) type (TYPE_VOID.default); //BSBS: Alias.
    };
    result
  );
  
  - '==' Right 60 other:TYPE :BOOLEAN <- 
  ( + t:PROFIL_BLOCK;
    + result:BOOLEAN;

    result := (Self = other) || {other = type_block} || {
      t ?= other;
      t != NULL
    };
    result
  );
  
  - append_name_in buf:STRING <-  
  (
    buf.append (ALIAS_STR.prototype_block);
  );

  - prototype:PROTOTYPE <- type_block.prototype;
  
  - subtype_list:HASHED_SET[TYPE] <- type_block.subtype_list;
  - add_subtype t:TYPE <- type_block.add_subtype t;
  
  - get_slot n:STRING_CONSTANT :SLOT <-
  (
    type_block.get_slot n
  );
  
  - get_local_slot n:STRING_CONSTANT :SLOT <-
  (
    type_block.get_local_slot n
  );
  
  - get_path_slot n:STRING_CONSTANT :SLOT <-
  (
    type_block.get_path_slot n
  );
  
  - genere_struct <-
  (
    // Nothing.
  );
         
  //
  // Code source generation.
  //
  
  - put_id buffer:STRING <- index.append_in buffer;
  
  - put_access_id e:EXPR in buffer:STRING <- 
  (    
    e.genere buffer;
    buffer.append ".__id";
  );
  
  - put_value buffer:STRING <- 
  (
    index.append_in buffer;
  );
  
  - put_expanded_declaration buffer:STRING <-
  (    
    buffer.append type_c;    
  );  
  
Section Public

  - is_sub_type other:TYPE :BOOLEAN <- Self == other;
  
  //
  // Display.
  //
    
  - display buffer:STRING <-
  (    
    buffer.append "BLOCK SEND ";
    append_type buffer;
  );    
