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

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

  
  - author  := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment := "Type with attribute flags.";
  
Section Inherit  
  
  - parent_any:ANY := ANY;
  
Section Private
    
  + parent_type:TYPE;
  
Section TYPE, TYPE_FULL
  
  - get_with flg:UINTEGER_8 :TYPE_FULL <- parent_type.get_with flg;
  
Section Public  
  
  - get_slot n:STRING_CONSTANT :SLOT <- parent_type.get_slot n;
    
  - hash_code:INTEGER <- raw.name.hash_code;
  
  - size:INTEGER <- parent_type.size;
  
  - prototype:PROTOTYPE <- parent_type.prototype;
  
  - is_sub_type other:TYPE_FULL :BOOLEAN <- parent_type.is_sub_type (other.raw);
      
  - slot_run:FAST_ARRAY[SLOT] <- parent_type.slot_run;
  
  - is_late_binding:BOOLEAN <- parent_type.is_late_binding;

Section TYPE
    
  + flag:UINTEGER_8;
  // 7 6 5 4 3 2 1 0
  //     | | | | | +- 0:Reference / 1:Expanded
  //     | | | | +--- 0:Reference / 1:Expanded (by default)
  //     | | | +----- 0:Normal    / 1:Strict
  //     | | +------- 0:Normal    / 1:Strict (by default)
  //     | +--------- 0:Normal    / 1:Temporary
  //     +----------- 0:Normal    / 1:Old generic

  //
  // Creation.
  //
  
  - create typ:TYPE with code:UINTEGER_8 :SELF <-
  ( + result:SELF;
    
    result := clone;
    result.make typ with code;
    result    
  );
  
  - make typ:TYPE with code:UINTEGER_8 <-
  (
    parent_type := typ;
    flag := code;       
    ? {is_expanded -> (! is_strict)};
  );
  
Section Public

  - raw:TYPE <- parent_type;
  
  //
  // Set.
  //
  
  - expanded_bit        :UINTEGER_8 := 000001b;  
  - default_expanded_bit:UINTEGER_8 := 000010b;  
  - strict_bit          :UINTEGER_8 := 000100b;
  - default_strict_bit  :UINTEGER_8 := 001000b;
  - expanded_ref_bit    :UINTEGER_8 := 010000b;
  - generic_bit         :UINTEGER_8 := 100000b;
    
  //
  // Access.
  //
  
  - is_expanded          :BOOLEAN <- (flag & expanded_bit        ) != 0;
  - is_default_expanded  :BOOLEAN <- (flag & default_expanded_bit) != 0;
  - is_strict            :BOOLEAN <- (flag & strict_bit          ) != 0;
  - is_default_strict    :BOOLEAN <- (flag & default_expanded_bit) != 0;
  - is_expanded_ref      :BOOLEAN <- (flag & expanded_ref_bit    ) != 0;
  - is_generic           :BOOLEAN <- (flag & generic_bit         ) != 0;
  
  - is_expanded_c:BOOLEAN <- (is_expanded) && {raw.type_c != NULL};
  
  - '==' Right 60 other:TYPE_FULL :BOOLEAN <-
  (
    (Self = other) || {(raw = other.raw) && {(flag & 01111b) = (other.flag & 01111b)}}
  );
  
  - '!==' Right 60 other:TYPE_FULL :BOOLEAN <- ! (Self == other);
  
  - append_name_in buffer:STRING <-
  (
    (is_strict).if {
      buffer.append "Strict ";
    };
    (is_expanded).if {
      buffer.append "Expanded ";
    };    
    buffer.append (raw.name);
  );
  
  //
  // Operation.
  //
  
  - '+' other:UINTEGER_8 :TYPE_FULL <- get_with (flag | other);
  
  - '-' other:UINTEGER_8 :TYPE_FULL <- get_with (flag & ~other);
  
  - to_strict:TYPE_FULL <-
  ( + result:TYPE_FULL;
    
    (is_expanded).if {
      result := Self;
    } else {      
      result := get_with (flag | strict_bit);     
    };
    result
  );

  - to_no_strict:TYPE_FULL <-
  ( + result:TYPE_FULL;
    
    (is_expanded).if {
      result := Self;
    } else {      
      result := get_with (flag & ~strict_bit);     
    };
    result
  );
  
  //
  // Variable product.
  //
  
  - new_local p:POSITION name n:STRING_CONSTANT style s:CHARACTER :LOCAL <-
  (
    LOCAL.create p name n style s type Self
  );
  
  - get_temporary_expr p:POSITION :EXPR <-
  ( + result:EXPR;  
    
    (raw = TYPE_VOID).if {
      result := PROTOTYPE_CST.create p type (TYPE_VOID.default); //BSBS: Alias.
    } else {
      result := get_temporary p.read p;
    };
    result
  );
  
  - get_temporary p:POSITION :LOCAL <-
  (     
    new_local p name (ALIAS_STR.variable_tmp) style '+'
  );  

  - get p:POSITION result n:INTEGER :LOCAL <-
  (     
    string_tmp.copy (ALIAS_STR.keyword_result);
    (n != 0).if {
      string_tmp.add_last '_';
      n.append_in string_tmp;
    };
    new_local p name (ALIAS_STR.get string_tmp) style '+'
  );  
    
  //
  // Type Control.
  //
  
  //+----------+----------+----------+----------+
  //| A := B-->| Reference| Expanded | Strict   |
  //| V        | TYPE     | TYPE     | TYPE     |
  //+----------+----------+----------+----------+
  //| Reference| B.sub A  | FALSE    | B.sub A  |
  //| TYPE     |          |          |          |
  //+----------+----------+----------+----------+
  //| Expanded | FALSE    | A = B    | A = B    |
  //| TYPE     |          |          |          |
  //+----------+----------+----------+----------+
  //| Strict   | FALSE    | FALSE    | A = B    |
  //| TYPE     |Sauf NULL |          |          |
  //+----------+----------+----------+----------+
  - affect_with other:TYPE_FULL :BOOLEAN <-
  ( + result:BOOLEAN;
        
    (other == Self).if {
      result := TRUE;
    } else {      
      (other != NULL).if {
	(is_strict).if {
	  // A: Strict.
	  result := other.raw = TYPE_NULL;
	}.elseif {is_expanded} then {
	  // A: Expanded.
	  result := 
	  ((other.is_strict)    && {raw == other.raw      }) ||
	  {(raw = type_boolean) && {other.is_sub_type Self}} ||
	  {(raw = type_pointer) && {other.raw = TYPE_NULL }};	  
	} else {
	  // A: Reference.
	  result := ((! other.is_expanded) || {raw = type_block}) && {other.is_sub_type Self}; 
	};	
      };
    };
    result
  );
  
  //
  // Import / Export manager.
  //
  
  - last_cast_name:STRING := STRING.create 32;
  
  - is_export_to t:TYPE_FULL :BOOLEAN <- 
  (         
    is_cast (ALIAS_STR.slot_to) to t in (prototype.export_list)
  );
      
  - is_import_to t:TYPE_FULL :BOOLEAN <-
  (     
    is_cast (ALIAS_STR.slot_from) to t in (prototype.import_list)
  );
  
  //
  // Default value.
  //
  
  - default_value p:POSITION :EXPR <- 
  ( + result:EXPR;
    
    ((prototype != NULL) && {prototype.default_value != NULL}).if {
      // Prototype User definition.	      
      result := prototype.default_value.to_run_expr;
    } else {
      (is_expanded).if {      
	// Copy of model prototype.
	result := PROTOTYPE_CST.create p type Self;
      } else {
	result := PROTOTYPE_CST.create p type (TYPE_NULL.default);
      };      
    };
    
    result
  );
  
  //
  // Declaration generation.
  //
 
  - genere_declaration buffer:STRING <-
  ( 
    (is_expanded).if {
      raw.put_expanded_declaration buffer;
    }.elseif {is_strict} then {
      raw.put_reference_declaration buffer;
    } else {      
      raw.put_generic_declaration buffer;      
    };
  );
      
  - genere_star_declaration buffer:STRING <-
  ( 
    ((! is_expanded) || {is_expanded_ref}).if {
      raw.put_reference_star_declaration buffer;
    };
  );
  
  //
  // Generation code.
  //
  
  - genere_value buffer:STRING <-
  ( + tb:PROFIL_BLOCK;
    (
      (is_expanded) && {! is_expanded_ref} && 
      {raw != type_true} && {raw != type_false} &&
      {tb ?= raw; tb = NULL}
    ).if {
      buffer.append "(*";
      raw.put_value buffer;
      buffer.add_last ')';      
    } else {
      raw.put_value buffer;
    };
  );
  
  //
  // Display.
  //
  
  - display buf:STRING <-
  (
    (is_generic).if {
      buf.append "Generic ";
    };
    append_name_in buf;
  );
  
  - print <-
  (
    string_tmp.clear;
    display string_tmp;
    string_tmp.print;
  );
  
  - print_full <-
  (
    string_tmp.clear;
    display string_tmp;
    string_tmp.add_last ' ';
    string_tmp.add_last '[';
    (is_expanded).if {
      string_tmp.add_last 'e';
    };
    (is_default_expanded).if {
      string_tmp.add_last 'E';
    };
    (is_strict).if {
      string_tmp.add_last 's';
    };
    (is_default_strict).if {
      string_tmp.add_last 'S';
    };
    (is_temporary).if {
      string_tmp.add_last 'T';
    };
    (is_generic).if {
      string_tmp.add_last 'G';
    };
    string_tmp.add_last ']';
    //
    string_tmp.print;
  );
  
Section Private
  
  - is_cast n:STRING_CONSTANT to t:TYPE_FULL in lst:FAST_ARRAY[ITM_TYPE_MONO] :BOOLEAN <-
  ( + j:INTEGER;
    + result:BOOLEAN;
    + old_self_up:TYPE;
    
    (lst != NULL).if {
      old_self_up := ITM_TYPE_SELF.self_up;
      ITM_TYPE_SELF.set_self_up raw;
      
      j := lst.lower;
      {
	(j <= lst.upper) && 
	{lst.item j.to_run != t}
      }.while_do {
	j := j + 1;
      };
      
      ITM_TYPE_SELF.set_self_up old_self_up;
      
      (j <= lst.upper).if {
	result := TRUE;
	last_cast_name.copy n;
	lst.item j.append_cast_name_in last_cast_name;	
      };
    };
    result
  );
