implementation module TypeImplementationTable;

import type_io_read;
import StdMaybe;
import ExtArray;
from ExtList import isMemberP;

:: *TypeImplementationTable
	= {
		teit_n_type_implementations		:: !Int
	,	teit_type_implementations_a		:: !*{#TypeImplementation}
	};
	
default_type_implementation_table :: !*TypeImplementationTable;
default_type_implementation_table
	= {
		teit_n_type_implementations		= 0
	,	teit_type_implementations_a		= {}
	};
	
get_type_implementations_a :: !*TypeImplementationTable -> (!*{#TypeImplementation},!*TypeImplementationTable);
get_type_implementations_a tit=:{teit_type_implementations_a}
	= (teit_type_implementations_a,{tit & teit_type_implementations_a = {}});
			
:: TypeImplementation
	= {
		tei_type_implementations		:: [LibraryInstanceTypeReference]				// all but one of the type implementation must be free i.e. not have an implementation
	,	tei_chosen_type_implementation	:: !Maybe !LibraryInstanceTypeReference			// type implementation which is not free i.e. an implementation has been linked
	};
// ==
instance DefaultElem TypeImplementation
where {
	default_elem 
		= {
			tei_type_implementations		= []
		,	tei_chosen_type_implementation	= Nothing
		};
	

};

:: TypeImplementationReference
	:== Int;	
/*

:: RTTypeReference 
	= PredefinedType !Int !String					// fst Int is index in cs_type_tables
	| TypeReference !Int !TIO_TypeReference			// fst Int is index in cs_type_tables
	
:: LibraryInstanceTypeReference 
	= LIT_PredefinedType !Int !String				// fst Int is index in cs_library_instances
	| LIT_TypeReference !Int !TIO_TypeReference		// fst Int is index in cs_library_instances

*/

//enter_type_implementation :: LibraryInstanceTypeReference LibraryInstanceTypeReference 

// per dynamic?
// class?


// DLClientState
// associates type1, type2 and possible other type implementations.
// if type2 has already been entered, then type1 is associated with type2 and the types to which
// type2 is equivalent.
// otherwise type2 has not yet been entered, then an type equivalence class with type1 and type2
// as initial members is created.
class enter_type_equation s :: LibraryInstanceTypeReference LibraryInstanceTypeReference !*s -> (Maybe (!TypeImplementationReference,!Bool),!*s);

instance enter_type_equation TypeImplementationTable
where {
//	enter_type_equation :: LibraryInstanceTypeReference LibraryInstanceTypeReference !*TypeImplementationTable -> (!TypeImplementationReference,!*TypeImplementationTable);
	enter_type_equation type1 type2 tit=:{teit_n_type_implementations}
		| isTypeWithoutDefinition type1 || isTypeWithoutDefinition type2 <<- ("enter_type_equation (TypeImplementationTable)",type1,type2)
		
			= (Nothing,tit);
			
		// find type2 or create new index
		# (type2_found,tit)
			= findAst (find_type_equivalence_class type2) tit teit_n_type_implementations;

		# (index,created_new_type_equivalence_class,tit)
			= case type2_found of { 
				Nothing
					// no type equivalence class found, generate a new one
					# (type_implementations_a,tit=:{teit_n_type_implementations})
						= get_type_implementations_a tit;
					# (new_index,type_implementations_a)
						= extend_array 1 type_implementations_a;
						
					// add new type implementation
					# type_implementation
						= { default_elem &
							tei_type_implementations = [type1,type2]
						};
	
					# tit
						= { tit &
							teit_n_type_implementations	= inc teit_n_type_implementations
						,	teit_type_implementations_a	= { type_implementations_a & [new_index] = type_implementation }
						};
					# created_new_type_equivalence_class
						= True;
//					| True <<- "ksd"
					-> (new_index,created_new_type_equivalence_class,tit);
							
				Just index_of_type_equivalence_class
					// get type implememntation
					# (type_implementation=:{tei_type_implementations},tit)
						= tit!teit_type_implementations_a.[index_of_type_equivalence_class];
						
						
					# (type1_found,tit)
						= find_type_equivalence_class type1 index_of_type_equivalence_class tit;
					# tit
						= case type1_found of {
							Just _
								-> tit;
							Nothing
								// update it
								# updated_type_implementation
									= { type_implementation &
										tei_type_implementations = [type1:tei_type_implementations]
									};
								// put type implementation back
								# tit
									= { tit & 
										teit_type_implementations_a = { tit.teit_type_implementations_a & [index_of_type_equivalence_class] = updated_type_implementation}
									};
								-> tit;
							};
						
					# created_new_type_equivalence_class
						= False;
						
					-> (index_of_type_equivalence_class,created_new_type_equivalence_class,tit);
			};
		= (Just (index,created_new_type_equivalence_class),tit);
};
	
find_type_equivalence_class :: !LibraryInstanceTypeReference !.Int !*TypeImplementationTable -> !*(!Maybe !Int,*TypeImplementationTable);
find_type_equivalence_class type2 index_of_type_equivalence_class tit
	# (type_implementation=:{tei_type_implementations},tit)
		= tit!teit_type_implementations_a.[index_of_type_equivalence_class];
	| isMember type2 tei_type_implementations //<<- ("find_type_equivalence_class",tei_type_implementations)
		= (Just index_of_type_equivalence_class,tit); //<<- "found!";
		= (Nothing,tit); //<<- "not found!";
// == 
		
class getImplementationType s :: !TypeImplementationReference !*s -> *(Maybe LibraryInstanceTypeReference,*s);

instance getImplementationType TypeImplementationTable
where {
	getImplementationType index_of_type_equivalence_class tit
		= get_implementation_type_for_equivalence_class index_of_type_equivalence_class tit;
};
		
get_implementation_type_for_equivalence_class :: !TypeImplementationReference !*TypeImplementationTable -> *(Maybe LibraryInstanceTypeReference,*TypeImplementationTable);
get_implementation_type_for_equivalence_class index_of_type_equivalence_class tit
	= tit!teit_type_implementations_a.[index_of_type_equivalence_class].tei_chosen_type_implementation;

class enter_implementation_type_for_equivalence_class s :: !TypeImplementationReference !Int !*s -> !*s;

instance enter_implementation_type_for_equivalence_class TypeImplementationTable
where {

// :: !TypeImplementationReference !Int !*TypeImplementationTable -> !*TypeImplementationTable;
	enter_implementation_type_for_equivalence_class index_of_type_equivalence_class library_instance_i_implements_type_equivalence_class tit
		# (type_implementation=:{tei_type_implementations,tei_chosen_type_implementation},tit)
			= tit!teit_type_implementations_a.[index_of_type_equivalence_class];
		| isJust tei_chosen_type_implementation
			// an type implementation has been chosen for the equivalence class at index_of_type_equivalence_class
			= tit;
			
		// list all possible implementations within same library instance 
		# possible_implementation_types
			= filter (\library_instance_type_reference -> (get_library_instance_i library_instance_type_reference) == library_instance_i_implements_type_equivalence_class) tei_type_implementations
		| isEmpty possible_implementation_types
			= abort ("enter_implementation_type_for_equivalence_class; internal error; missing type implementation for this class" );
			
			# tit
				= { tit & teit_type_implementations_a.[index_of_type_equivalence_class].tei_chosen_type_implementation = Just (hd possible_implementation_types) };
			= tit;
	where {
		get_library_instance_i (LIT_TypeReference (LibRef library_instance_i) _)		= library_instance_i;
		get_library_instance_i _														= abort "enter_implementation_type_for_equivalence_class; unimplemented";
	};		
};

class enter_implementation_type_for_equivalence_class2 s :: !TypeImplementationReference !LibraryInstanceTypeReference !*s -> !*s;

instance enter_implementation_type_for_equivalence_class2 TypeImplementationTable
where {
	//:: !TypeImplementationReference !LibraryInstanceTypeReference !*TypeImplementationTable -> !*TypeImplementationTable;
	enter_implementation_type_for_equivalence_class2 index_of_type_equivalence_class type_implementing_type_equivalence_class tit
		# (type_implementation=:{tei_type_implementations,tei_chosen_type_implementation},tit)
			= tit!teit_type_implementations_a.[index_of_type_equivalence_class];
		| isJust tei_chosen_type_implementation
			// an type implementation has already been chosen for the equivalence class at index_of_type_equivalence_class. This
			// is a fatal error because the implementation may only be set once.
			= abort "enter_implementation_type_for_equivalence_class2; internal error; type implementation for an equivalence class should only be set once";
			
		// check if type is a representative of the equivalent class
		# (found,tit)
			= find_type_equivalence_class type_implementing_type_equivalence_class index_of_type_equivalence_class tit;
		| isNothing found
			= abort ("enter_implementation_type_for_equivalence_class2; internal error; type is not member of the specified type equivalent class ");
			
			# tit
				= { tit & teit_type_implementations_a.[index_of_type_equivalence_class].tei_chosen_type_implementation = Just type_implementing_type_equivalence_class };
			= tit;
};
		
class findImplementationType s :: !LibraryInstanceTypeReference !*s -> (!Bool,!Maybe !TypeImplementationReference,!*s);

import RWSDebugChoice;
instance findImplementationType TypeImplementationTable
where {
	findImplementationType type tit=:{teit_n_type_implementations}
//		| True <<- ("findImplementationType", type)
		#! (type_found,tit)
			= findAst (find_type_equivalence_class type) tit teit_n_type_implementations;
		= (isJust type_found,type_found,tit);
		
/*
			// type is *not* contained in a type equivalence class
			= (False,Nothing,tit);
			
//			# (tei_chosen_type_implementation,tit)
//				= tit!teit_type_implementations_a.[fromJust type_found].tei_chosen_type_implementation;
			= (True,tei_chosen_type_implementation,tit);
*/
};

//enter_initial_type_implementation tit
//1.3
extend_array :: !Int *{#a} -> (!Int,*{#a}) | ArrayElem, DefaultElem a;
//3.1
/*2.0
extend_array :: .Int .(a b) -> (Int,.(c b)) | Array c b & Array a b & DefaultElem b;
0.2*/
extend_array n_new_elements a 
	# (s_a,a)
		= usize a;
	# s_new_a
		= s_a + n_new_elements;
	# new_a
		= createArray s_new_a default_elem;
	# new_a
		= { new_a & [i] = a.[i] \\ i <- [0..dec s_a] };
	= (dec s_new_a,new_a);

class get_type_implementation s :: !Int !*s -> (!TypeImplementation,!*s);

instance get_type_implementation TypeImplementationTable
where {
	get_type_implementation index_of_type_equivalence_class tit
		= tit!teit_type_implementations_a.[index_of_type_equivalence_class];
};
		
// A set of *lazy* type equations are directly inserted in the type implementation table. These types may
// not be implemented i.e. linked already!
//add_lazy_type_equations :: !.Int [.LibraryInstanceTypeReference] !*TypeImplementationTable -> *TypeImplementationTable;
class add_lazy_type_equations s :: !.Int [.LibraryInstanceTypeReference] !*s -> *s;

instance add_lazy_type_equations TypeImplementationTable
where {
	add_lazy_type_equations index library_instance_type_references type_implementation_table
		# (tei_type_implementations,type_implementation_table)
			= type_implementation_table!teit_type_implementations_a.[index].tei_type_implementations;
		# type_implementation_table
			= { type_implementation_table & 
				teit_type_implementations_a.[index].tei_type_implementations = library_instance_type_references ++ tei_type_implementations
			};
		= type_implementation_table;
};