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

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

  
  - author      := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment     := "Switch node for type";
    
Section Inherit
  
  + parent_node:Expanded NODE;
  
Section Public
    
  - result_expr:EXPR <- data.result_expr;
  
  + is_self:BOOLEAN;
  
  //
  // Creation.
  //
  
  - create e:EXPR with d:DTA :SELF <-
  // Create with back-link.
  ( + result:SELF;
    
    result := clone;
    result.make e with d;
    result
  );
      
  - make e:EXPR with d:DTA <-
  (
    expr     := e;
    data     := d;
    late_binding_counter := late_binding_counter + 1;
  );
    
Section Public
  
  - my_copy:SELF <-
  ( + result:SELF;
    
    result := SELF.create (expr.my_copy) with data;    
    node_list.add_last result; 
    result
  );
    
  //
  // Update.
  //
  
  - update:BOOLEAN <-
  (
    update_case & update_depth TRUE    
  );
  
Section NODE, DTA
  
  - update_link:BOOLEAN <-
  (     
    update_case & update_depth FALSE    
  );
  
Section Public
/*  
  - count_flat:INTEGER;
  - count_not_flat:INTEGER;
  
  - reset_count_flat <-
  (
    count_not_flat := 0;
    count_flat := 0;
  );
*/
Section Private  
    
  - update_case:BOOLEAN <-
  ( + typ_f:TYPE_FULL;
    + typ:TYPE;
    + lst_typ:TYPES_TMP;
    + list:FAST_ARRAY[CASE];
    + case:CASE;
    + result:BOOLEAN;
    + tb:PROFIL_BLOCK;
            
    typ_f := expr.static_type;
    tb ?= typ_f.raw;
    (
      (typ_f.is_expanded && {typ_f.raw != type_boolean}) || 
      {tb != NULL}
    ).if {
      (first_code = NULL).if {
	first_type := typ_f.raw;
	first_code := data.product first_type with expr;
      };
      result := TRUE;
    }.elseif {(typ_f.raw = type_boolean) && {count = 2}} then {
      result := TRUE;
    } else {	
      ((typ_f.raw = type_block) || {typ_f.raw.subtype_list.count != count}).if {
	lst_typ := TYPES_TMP.new;      
	expr.get_type lst_typ;      
	(! lst_typ.is_empty).if {
	  (lst_typ.count = 1).if {
	    (first_code = NULL).if {
	      first_type := lst_typ.first;
	      first_code := data.product first_type with expr;
	    };
	  } else {
	    (switch = NULL).if {
	      switch := SWITCH.create Self with expr size (lst_typ.count);
	    };
	    list := switch.list;
	    (list.count != lst_typ.count).if {
	      (lst_typ.lower).to (lst_typ.upper) do { j:INTEGER;	    
		typ := lst_typ.item j;	    
		((j > list.upper) || {typ != list.item j.id}).if {
		  add_stack_type typ;
		  //
		  case := CASE.create typ with (data.product typ with expr);		
		  list.add case to j;
		  //
		  stack_type.remove_last;
		};	    
	      };	  	  	  
	    };
	  };
	};
	lst_typ.free;
      } else {
	//count_flat := count_flat + 1;
	//"Yes\n".print;
      };
    };    
    result
  );
  
  - update_depth is_first:BOOLEAN :BOOLEAN <-
  ( + result:BOOLEAN;
    + list:FAST_ARRAY[CASE];
    + typ:TYPE_FULL;
    
    (switch = NULL).if {
      (first_code != NULL).if {
	(is_first).if {	  
	  typ := expr.static_type;
	  (! typ.is_expanded).if {
	    typ := first_type.default.to_strict;
	  };
	  ITM_TYPE_SELF.set_run typ;
	};
	add_stack_type first_type;
	result := data.update_branch first_code;
	stack_type.remove_last;
      };
    } else {
      list := switch.list;
      (list.lower).to (list.upper) do { j:INTEGER;
	(is_first).if {
	  ITM_TYPE_SELF.set_run (list.item j.id.default.to_strict);
	};
	add_stack_type (list.item j.id);
	data.update_branch (list.item j.code);
	stack_type.remove_last;
      };
    };
    result
  );
  
Section Private 
  
  - stack_type:FAST_ARRAY[TYPE] := FAST_ARRAY[TYPE].create_with_capacity 16;
  
  - add_stack_type t:TYPE <-
  (
    stack_type.add_last t;
    ((stack_type.count > 1) && {stack_type.first = t}).if {      
      string_tmp.copy "Cyclic inheritance : ";
      (stack_type.lower).to (stack_type.upper) do { j:INTEGER;
	stack_type.item j.append_name_in string_tmp;
	string_tmp.append ", ";
      };
      string_tmp.append "...";
      semantic_error (data.position, string_tmp);
    };
  );