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]				// unique,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;	

// 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.

create_type_equivalent_class type1 type2 tit :== enter_type_equation type1 type2 tit;

class enter_type_equation s :: LibraryInstanceTypeReference LibraryInstanceTypeReference !*s -> (Maybe (!TypeImplementationReference,!Bool),!*s);

instance enter_type_equation TypeImplementationTable
where {
	enter_type_equation type1 type2 tit=:{teit_n_type_implementations}
		| isTypeWithoutDefinition type1 || isTypeWithoutDefinition 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;
					-> (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
		= (Just index_of_type_equivalence_class,tit);
		= (Nothing,tit);
		
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 {
	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}
		#! (type_found,tit)
			= findAst (find_type_equivalence_class type) tit teit_n_type_implementations;
		= (isJust type_found,type_found,tit);
};

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!
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;
};

find_TypeImplementationTable :: (Int -> .(TypeImplementation -> .(.a -> (Maybe b,.a)))) !*TypeImplementationTable .a -> *(Maybe b,*(*TypeImplementationTable,.a));
find_TypeImplementationTable find_function tit=:{teit_n_type_implementations} state
	= findAst local_find_function (tit,state) teit_n_type_implementations;
where {
	local_find_function ith_entry (tit,state)
		# (type_implementation,tit)
			= tit!teit_type_implementations_a.[ith_entry];
		# (result,state)
			= find_function ith_entry type_implementation state;
		= (result,(tit,state));
};

class set_type_equations s :: !.Int [.LibraryInstanceTypeReference] !*s -> *s;

instance set_type_equations TypeImplementationTable
where {
	set_type_equations index library_instance_type_references type_implementation_table
		# type_implementation_table
			= { type_implementation_table & 
				teit_type_implementations_a.[index].tei_type_implementations = library_instance_type_references
			};
		= type_implementation_table;
};