implementation module link_library_instance;

// StdLib
import StdMaybe;

// Linkers
import dus_label;
import DLState;
import ObjectToMem;
import pdObjectToMem;
from SearchObject import add_module2, add_library2;
import lib;
import ReadObject;
import CollectTypes;
import check_types;
import DLState;
import link_switches;
import DynID;
// ?
import ExtFile;

// StdDynamicEnv
from DynamicLinkerInterface import ::TypeReference(..), ::LibraryID(..);

// compiler
import utilities;
from predef import UnderscoreSystemDynamicModule_String, DynamicRepresentation_String;


initialize_internal_type_equivalence_classes library_instance_i dl_client_state io
	#! (li_library_initialized,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized;
		
	#! (type_table_i,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
	#! (tis_equivalent_type_definitions,dl_client_state)
		= dl_client_state!cs_type_tables.[type_table_i].tt_type_io_state.tis_equivalent_type_definitions;

	#! (dl_client_state,io)
		= case (not li_library_initialized) && (size tis_equivalent_type_definitions <> 0) of {
			True
				// there are internal type equations for this library
				#! (dl_client_state,io)
					= foldlNonUniqueArraySt (enter_equally_named_type_equivalences type_table_i) tis_equivalent_type_definitions (dl_client_state,io)
			 	-> (dl_client_state,io);
			_
				-> (dl_client_state,io);
		};
	= (dl_client_state,io);
where {
	enter_equally_named_type_equivalences type_table_i {type_name,partitions} (dl_client_state,io)
		#! (dl_client_state,io)
			= MAKE_INTERNAL_TYPES_USE_SINGLE_IMPLEMENTATION (foldlNonUniqueArraySt enter_type_equivalent_class partitions (dl_client_state,io)) (dl_client_state,io);
		= (dl_client_state,io);
	where {
		enter_type_equivalent_class type_equivalent_class (dl_client_state,io)
			| (size type_equivalent_class < 2) <<- ("Enter_type_equivalent_class",type_equivalent_class)
				= abort "enter_type_equivalent_class; internal error; type equivalent class must contain at least two elements";
				
				#! (x,dl_client_state,io)
					= enter_type_equation_new [LIT_TypeReference (LibRef library_instance_i) tio_type_ref \\ tio_type_ref <-: type_equivalent_class ] dl_client_state io;
				| isNothing x
					#! msg 
						= "initialize_internal_type_equivalence_classes; type synonym ignored";
					#! dl_client_state
						= AddMessage (LinkerWarning msg) dl_client_state
					= (dl_client_state,io);
				
				#! (ref,_)
					= fromJust x;
				#! (maybe_class_implementation,dl_client_state)
					= dl_client_state!cs_type_implementation_table.teit_type_implementations_a.[ref].tei_chosen_type_implementation;
				#! (dl_client_state,io)
					= case maybe_class_implementation of {
						Nothing
							#! tio_type_reference
								= type_equivalent_class.[0];
							#! (type_name,labels,dl_client_state)
								= get_type_label_names tio_type_reference type_table_i dl_client_state;
							#! labels
								= Just [ { default_elem &
										dusl_label_name				= label_name 
									,	dusl_library_instance_i		= library_instance_i
									,	dusl_linked					= False
									}
									\\
									label_name
									<- labels
								];
							#! (i,_,dl_client_state,io)
								= load_code_library_instance labels library_instance_i dl_client_state io;
								
							| False <<- ("\n--------------------------------------------------------------")
								-> undef;
							
							// up-date type implementation table
							#! (Just (ref1,_),dl_client_state,io)
								= enter_type_equation_new [LIT_TypeReference (LibRef library_instance_i) tio_type_reference] dl_client_state io;
							| ref1 == ref
								-> (dl_client_state,io);
								-> abort ("fout, inlinken van een van de types for '"  +++ "'" +++ toString i);
						Just _
							// there is already an type implementation for the class.
							-> (dl_client_state,io);
					};
				= (dl_client_state,io);

		enter_type_equivalent_class _ (dl_client_state,io)
			= abort "sss";

	};
};


initialize_library_instance :: !Int !*DLClientState *f -> (!Bool,!*DLClientState,!*f) | FileEnv f;
initialize_library_instance library_instance_i dl_client_state io
	#! (li_library_initialized,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized;
	| li_library_initialized
		= (False,dl_client_state,io);	
		
	#! msg
		= "	initialize_library_instance	" +++ toString library_instance_i;
	#! dl_client_state
		= AddMessage (Verbose msg) dl_client_state;

	# (li_library_name,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_name;
	# li_library_name
		= fromJust li_library_name;
	#! (type_table_i,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
	#! (state,dl_client_state)
		= get_state dl_client_state;

	#! (Just main_library_instance_i,dl_client_state)
		= dl_client_state!cs_main_library_instance_i;
	#! (do_dump_dynamic,dl_client_state)
		= dl_client_state!do_dump_dynamic;
	#! is_dump_dynamic_main_library
		= library_instance_i == main_library_instance_i && do_dump_dynamic;
		
	#! is_main_library_instance
		= library_instance_i == main_library_instance_i;
		
	#! (share_runtime_system,dl_client_state)
		= dl_client_state!cs_share_runtime_system;
	#! dl_client_state
		= { dl_client_state & cs_share_runtime_system = True };
	# dl_client_state
		= case share_runtime_system of {
			False
				-> { dl_client_state &
					cs_main_library_instance_i = Just library_instance_i
					};
			_
				-> dl_client_state;
		};

	// load library
	# ({rti_n_libraries=n_libraries,rti_n_library_symbols=n_library_symbols,rti_library_list=library_list},dl_client_state)
		= dl_client_state!cs_type_tables.[type_table_i].tt_rti;


	// mark library instance i as initialized
	#! dl_client_state 
		= { dl_client_state &
			cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized = True
		};
		
		
	#! (n_old_libraries,state)
		= state!n_libraries;
		
	// import DLL symbols
	#! (symbol_n,library_n,names_table)
		= ImportDynamicLibrarySymbols library_list 0 (~(n_libraries + n_old_libraries)) create_names_table;
	| symbol_n <> n_library_symbols || library_n <> (~n_old_libraries)
		= abort "LoadCodeLibraryInstance: internal error; .typ-file corrupt";
		
	// LibraryList
	#! state
		= add_library2 n_libraries n_library_symbols library_list state;

	// load code library *without* run-time system which is shared with the main library
	// instance.
	# (do_dump_dynamic,dl_client_state)
		= dl_client_state!do_dump_dynamic;

	# (rs,dl_client_state)
		= case share_runtime_system of {
			False
				-> (default_redirection_state,dl_client_state);
			_
				# (cs_main_library_instance_i,dl_client_state)
					= dl_client_state!cs_main_library_instance_i;
				# main_library_instance_i
					= fromJust cs_main_library_instance_i;

				# library_name
					= (snd (ExtractPathAndFile li_library_name));
				# library_name
					= "_" +++ (library_name % (0,size library_name - 2))   +++ "_options.o";
				# rts_objects
					= ["_startup0.o",library_name,"_startup1.o","_startup2.o","_startup1Profile.o","_startup1Trace.o","_system.o"];
				#! (names_table,dl_client_state)
					= acc_names_table main_library_instance_i dl_client_state;					

				# rs
					= { default_redirection_state &
					 	rs_main_names_table		= names_table
					,	rs_rts_modules			= rts_objects
					};
				-> (rs,dl_client_state);
		};
		
	# (n_xcoff_files,state)
		= state!n_xcoff_files;
	# code_lib_name
		= ADD_CODE_LIBRARY_EXTENSION li_library_name;
	# (s_names_table,names_table)
		= usize names_table;
	# ((errors, xcoff_l, names_table, _,rs),io)
		= accFiles (read_code_library2 (n_xcoff_files) [] code_lib_name names_table rs) io;				

	// restore name table
	# dl_client_state
		= case share_runtime_system of {
			False
				-> dl_client_state;
			_
				# (cs_main_library_instance_i,dl_client_state)
					= dl_client_state!cs_main_library_instance_i;
				# main_library_instance_i
					= fromJust cs_main_library_instance_i;

				# dl_client_state
					= { dl_client_state &
						cs_library_instances.lis_library_instances.[main_library_instance_i].li_names_table = rs.rs_main_names_table 
					};
				-> dl_client_state;
		};
		
	#! state = { state & 
		namestable				= names_table
	,	library_list 			= library_list
	};
		
	// add_module
	#! state
		= foldSt add_module2 xcoff_l state;
		
	// ------------------------
	// A lazy dynamic is marked by a BUILD_BLOCK_LABEL or a BUILD_LAZY_BLOCK_LABEL. Each library also defines these
	// two labels. Without precautions, these copies would also be put in the image, making the conversion routines
	// much more complex. Therefore the copy of the main library instance is taken and references of other library
	// instance are redirected to those of the main library instance.
	// backup namestable from state
	#! (names_table,state)
		= select_namestable state;
	#! dl_client_state
		= { dl_client_state &
			cs_library_instances.lis_library_instances.[library_instance_i].li_names_table = names_table
		};
		
	// body ...
	#! (state,dl_client_state)
		= case share_runtime_system of {
			False
				-> (state,dl_client_state);
			True
				// backup state
				#! dl_client_state
					= { dl_client_state &
						app_linker_state = state
					};
					
				// replace BUILD_BLOCK_LABEL
				#! (Just main_library_instance_i,dl_client_state)
					= dl_client_state!cs_main_library_instance_i;
				#! (Just (build_block_file_n,build_block_symbol_n),dl_client_state)
					= findLabel BUILD_BLOCK_LABEL main_library_instance_i dl_client_state;
				#! dl_client_state
					= replaceLabel BUILD_BLOCK_LABEL library_instance_i build_block_file_n build_block_symbol_n BUILD_BLOCK_LABEL dl_client_state;

				// replace BUILD_LAZY_BLOCK_LABEL
				#! (Just (build_lazy_block_file_n,build_lazy_block_symbol_n),dl_client_state)
					= findLabel BUILD_LAZY_BLOCK_LABEL main_library_instance_i dl_client_state;
				#! dl_client_state
					= replaceLabel BUILD_LAZY_BLOCK_LABEL library_instance_i build_lazy_block_file_n build_lazy_block_symbol_n BUILD_LAZY_BLOCK_LABEL dl_client_state;
					
				// extract state
				#! (state,dl_client_state)
					= acc_state (\state -> (state,EmptyState)) dl_client_state;
				
				-> (state,dl_client_state);
		};
	// ... body
		
	// restore namestable in state
	# dl_client_state
	 = { dl_client_state &
	 		app_linker_state	= state
	 	,	cs_library_instances.lis_library_instances.[library_instance_i].li_library_list = library_list
	 };

	= (share_runtime_system,dl_client_state,io);
where {
	read_code_library2 file_n module_to_be_removed code_lib_name names_table rs files 
		# (errors, xcoff_l, _, names_table, file_n, files,_,rs)
			= read_static_lib_files_new module_to_be_removed [code_lib_name] [] names_table file_n [] files default_rsl_state rs;
		= ((errors, xcoff_l, names_table, file_n,rs), files);
}

// loads both the code library assumes type table has already been loaded. The redirections to be made are derived from the 
// type table and imposed on the code.
load_code_library_instance :: (Maybe [.DusLabel]) !.Int !*DLClientState !*f -> (!Int,[Int],!*DLClientState,!*f) | FileEnv f;
load_code_library_instance non_main_library library_instance_i dl_client_state io
	#! (share_runtime_system,dl_client_state,io)
		= initialize_library_instance library_instance_i dl_client_state io;

	#! (library_list,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_list;
	#! dl_client_state
		= { dl_client_state &
			app_linker_state.library_list = library_list
		};
		
	// Can be removed.
//	#! (dl_client_state,io)
//		= update_namestable_to_include_recent_type_implementations library_instance_i dl_client_state io;
		
	#! (names_table,dl_client_state)
		= acc_names_table library_instance_i dl_client_state;
	#! (state,dl_client_state)
		= acc_state (\s -> (s,EmptyState)) dl_client_state;
	#! state 
		= { state &
			namestable = names_table
		,	library_list = library_list
		};

	#! (main_symbols,dl_client_state)
		= case non_main_library of {
			Nothing
				//  
				# (type_table_i,dl_client_state)
					= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
					
				# types
					= [
//					,	(T_ypeObjectTypeRepresentation_String,UnderscoreSystemDynamicModule_String)
					]
				# (labels,dl_client_state)
					= collect_type_labels types type_table_i dl_client_state;

				#! main_symbol
					= sel_platform "_mainCRTStartup" "main";
				#! main_symbols
					= [		SymbolUnknown  "" main_symbol
						,	SymbolUnknown "" BUILD_BLOCK_LABEL
						,	SymbolUnknown "" BUILD_LAZY_BLOCK_LABEL
						] 
						
						++ [ SymbolUnknown UnderscoreSystemDynamicModule_String label_name \\ label_name <- labels ];
						
				#! (teit_n_type_implementations,dl_client_state)
					= dl_client_state!cs_type_implementation_table.teit_n_type_implementations;
				-> (main_symbols,dl_client_state);

			(Just dus_labels)
				// exclude label which already have been linked by other library instances
				#! labels
					= [ SymbolUnknown "" dusl_label_name \\ {dusl_label_name,dusl_linked} <- dus_labels | not dusl_linked];
				-> (labels,dl_client_state);
		};

	/*
	** The preliminary temp solution above ensures that the RunTimeID-constructor is allocated into
	** library space and not lazily allocated in space for the graph_to_string-conversion function
	** which is not a library instance and therefore not included in the table which is sent to the
	** application and contains start/end addresses for each library instance. 
	** In the future the RunTimeID constructor of the context library should be used.
	*/ 
	#! ((wii,p=:[start_addr:_],state,dl_client_state),io)
		= LinkUnknownSymbols main_symbols state library_instance_i dl_client_state io;
	
	// LibraryList
	#! (names_table,state)
		= select_namestable state;
	#! (library_list,state)
		= state!library_list;

	#! dl_client_state
		= case wii of {
			Nothing
				-> dl_client_state;
			Just {wii_code_start,wii_code_end,wii_data_start,wii_data_end}
				#! (li_memory_areas,dl_client_state)
					= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_memory_areas;
				#! li_memory_areas
					= [{ma_begin=wii_data_start,ma_end=wii_data_end},{ma_begin=wii_code_start,ma_end=wii_code_end}:li_memory_areas];
				#! dl_client_state
					= { dl_client_state &
						cs_library_instances.lis_library_instances.[library_instance_i].li_memory_areas = li_memory_areas
					};
				-> dl_client_state;
		};
		
	// update		
	#! dl_client_state 
		= {  dl_client_state &
			cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized = True
		,	cs_library_instances.lis_library_instances.[library_instance_i].li_library_list = library_list
		,	cs_library_instances.lis_library_instances.[library_instance_i].li_names_table = names_table
		,	app_linker_state = state
		} 
	= (start_addr,p,dl_client_state,io);
where {
	check_label dl_client_state=:{cs_main_library_instance_i=Just main_library_instance_i}
		#! (Just (file_n,symbol_n),dl_client_state)
			= findLabel BUILD_BLOCK_LABEL main_library_instance_i dl_client_state
			
			
		= dl_client_state;	
	where {
		check_a_label label dl_client_state
			= undef 
			
	
	}

	f :: !*DLClientState -> !*DLClientState;
	f i = i;

	// to be removed ...
	update_namestable_to_include_recent_type_implementations library_instance_i dl_client_state io
		// extend available array if necessary
		#! (teit_n_type_implementations,dl_client_state)
			= dl_client_state!cs_type_implementation_table.teit_n_type_implementations;
		#! (li_s_type_available,dl_client_state)
			= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_s_type_available;
		#! dl_client_state
			= case (teit_n_type_implementations == li_s_type_available) of {
				True
					-> dl_client_state;
				False
					#! (dl_client_state,li_type_available)
						= loopAst copy_array_element (dl_client_state,createArray teit_n_type_implementations False) li_s_type_available;
					#! dl_client_state
						= { dl_client_state & 
							cs_library_instances.lis_library_instances.[library_instance_i].li_s_type_available = teit_n_type_implementations
						,	cs_library_instances.lis_library_instances.[library_instance_i].li_type_available = li_type_available
						};
					-> dl_client_state;
			};
			
		// teit_n_type_implementations is valid
		#! dl_client_state
			= loopAst enter_type_implementation_if_necessary dl_client_state teit_n_type_implementations;
		= (dl_client_state,io);
	where {
		copy_array_element i (dl_client_state,li_type_available)
			#! (ith_element,dl_client_state)
				= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_available.[i];
//			| True <<- (ith_element)
			#! li_type_available
				= { li_type_available & [i] = ith_element };
			= (dl_client_state,li_type_available);
			
		enter_type_implementation_if_necessary type_implementation_reference dl_client_state
			#! (type_equivalent_class_available,dl_client_state)
				= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_available.[type_implementation_reference];
			| type_equivalent_class_available // <<- ("daar",library_instance_i,type_implementation_reference,type_equivalent_class_available)
				// The NamesTable has already been modified for the current type equivalent class.
				= dl_client_state;
				
			#! ({tei_chosen_type_implementation,tei_type_implementations},dl_client_state)
				= get_type_implementation type_implementation_reference dl_client_state;
			| isNothing tei_chosen_type_implementation 
				// Type equivalent class has not yet an implementation
				= dl_client_state;
				
			#! (chosen_library_instance_i,chosen_tio_type_reference)
				= extract_LIT_TypeReference (fromJust tei_chosen_type_implementation);
			| chosen_library_instance_i == library_instance_i || (isTypeWithoutDefinition chosen_tio_type_reference)
				// No implementation but current library implements the type
				= dl_client_state;
				
			#! type_implementations_to_redirect
				= filter (\type_ref -> case type_ref of {
					(LIT_TypeReference (LibRef library_instance_j) _)
						-> library_instance_i == library_instance_j;
					_
						-> False;
					}) tei_type_implementations;
			| isEmpty type_implementations_to_redirect
				// A chosen implementation for the type equivalent class but the current library (library_instance_i) has no types
				// within the type equivalent class. So it can be ignored.
				= dl_client_state;
				
			// The type_implementations_to_redirect belong to type equivalent class having an implementation from another library instance.
			// If there are more than the library instance has also internal type equivalences. Now the namestable should be adapted to refer
			// to the type implementation in the other library.			
			// mark type as available
			#! dl_client_state
				= { dl_client_state & 
					cs_library_instances.lis_library_instances.[library_instance_i].li_type_available.[type_implementation_reference] = True
				};
				
			#! dl_client_state
				= redirect_type_implementation_equivalent_class (LIT_TypeReference (LibRef chosen_library_instance_i) chosen_tio_type_reference) type_implementations_to_redirect dl_client_state;
				
	
			= dl_client_state;
		where {
			extract_LIT_TypeReference (LIT_TypeReference (LibRef library_instance_i) tio_type_reference)
				= (library_instance_i,tio_type_reference);
		}
	};
	// ... to be removed

};

redirect_type_implementation_equivalent_class :: !.LibraryInstanceTypeReference ![.LibraryInstanceTypeReference] !*DLClientState -> *DLClientState;
redirect_type_implementation_equivalent_class (LIT_TypeReference (LibRef chosen_library_instance_i) chosen_tio_type_reference) type_implementations_to_redirect dl_client_state
	// get label names which implementent the chosen type implementation
	#! (li_chosen_type_table_i,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[chosen_library_instance_i].li_type_table_i;
	#! (chosen_type_name,labels_implementing_chosen_type,dl_client_state)
		= get_type_label_names chosen_tio_type_reference li_chosen_type_table_i  dl_client_state;
	#! (labels_implementing_chosen_type,dl_client_state)
		= mapSt (lookup_file_n_symbol_n_for_each_label chosen_library_instance_i) labels_implementing_chosen_type dl_client_state;

	| False <<- (chosen_type_name, labels_implementing_chosen_type,labels_implementing_chosen_type)
		= undef;

//		#! dl_client_state
//			= AddMessage (Verbose ("Patching NamesTable for '" +++ chosen_type_name +++ "'")) dl_client_state;

	// get labels for type_implementations_to_redirect
	#! (_,dl_client_state)
		= foldSt (redirect_type chosen_library_instance_i) type_implementations_to_redirect (labels_implementing_chosen_type,dl_client_state);
	= dl_client_state;
where {
	lookup_file_n_symbol_n_for_each_label chosen_library_instance_i type_label_name dl_client_state
		#! (maybe_file_n_symbol_n,dl_client_state)
			= findLabel type_label_name chosen_library_instance_i dl_client_state;
		| isNothing maybe_file_n_symbol_n
			= abort ("alal " +++ type_label_name);
			
		#! (file_n,symbol_n)
			= fromJust maybe_file_n_symbol_n;
		= ((file_n,symbol_n,type_label_name),dl_client_state);
};

redirect_type chosen_library_instance_i (LIT_TypeReference (LibRef library_instance_i) tio_type_reference) (labels_implementing_chosen_type,dl_client_state)
	#! (li_type_table_i,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
	#! (_,labels_implementing_type,dl_client_state)
		= get_type_label_names tio_type_reference li_type_table_i  dl_client_state;
		
	#! dl_client_state
		= fold2St redirect_type_label labels_implementing_type labels_implementing_chosen_type dl_client_state;
	= (labels_implementing_chosen_type,dl_client_state);
where {
	redirect_type_label refering_label chosen_label=:(file_n,symbol_n,chosen_label_name) dl_client_state
//				#! msg
//					= "> redirect '" +++ refering_label +++ "'<" +++ toString library_instance_i +++ "> to '"
//					+++ chosen_label_name +++ "'<" +++ toString chosen_library_instance_i +++ ">";
//				#! dl_client_state
//					= AddMessage (Verbose msg) dl_client_state;

		#! dl_client_state
			= replaceLabel refering_label library_instance_i file_n symbol_n chosen_label_name dl_client_state;
		= dl_client_state;
}; // redirect_type

redirect_type chosen_library_instance_i _ s
	= s;

collect_type_labels :: [(!String,!String)] !Int *DLClientState -> *(![String],*DLClientState);
collect_type_labels types type_table_i dl_client_state
	# (type_tables,dl_client_state)
		= get_type_tables dl_client_state;
		
	// collect types
	# (types,type_tables)
		= foldSt convert_type_name_into_tio_type_ref types ([],type_tables);
	| False //<<- ("types", types)
		= undef;
		
	# dl_client_state
		= { dl_client_state &
			cs_type_tables = type_tables
		};	
		
	// collect labels
	# (labels,dl_client_state)
		= foldSt (collect_labels_implementing_a_type type_table_i) types ([],dl_client_state)
	
	= (labels,dl_client_state);
	
where {
	convert_type_name_into_tio_type_ref (type_name,module_name) (types,type_tables)
		# (maybe_tio_type_reference,type_tables)
			= findTypeUsingTypeName type_name module_name type_table_i type_tables;
		| isNothing  maybe_tio_type_reference
			= abort ("convert_type_name_into_tio_type_ref: internal error; unknown type " +++ type_name);
			
			# type
				= TypeTableTypeReference type_table_i (fromJust maybe_tio_type_reference);		
			# (cts=:{cts_type_dependencies,cts_type_tables=type_tables})
				= collect_types type type {default_collect_types_state & cts_type_tables = type_tables};	
			= (cts_type_dependencies ++ types,type_tables);
		
	collect_labels_implementing_a_type type_table_i (tio_type_ref,_) (labels,dl_client_state)
		#! (type_name,labels_implementing_type,dl_client_state)
			= get_type_label_names tio_type_ref type_table_i dl_client_state;
		| False <<- ("<>", type_name,labels_implementing_type)
			= undef;
	
		= (labels_implementing_type ++ labels,dl_client_state);
}

LoadTypeTable :: .Int *DLClientState *a -> *(*DLClientState,*a) | FileEnv a;
LoadTypeTable type_table_i dl_client_state io
	# (tt_loaded,dl_client_state)
		= dl_client_state!cs_type_tables.[type_table_i].tt_loaded;
	| tt_loaded
		= (dl_client_state,io);

		// load type table
		# (tt_name,dl_client_state)
			= dl_client_state!cs_type_tables.[type_table_i].tt_name;
		# ((ok,rti,tio_common_defs,type_io_state,_),io)
			= accFiles (read_type_library_new False tt_name) io;
		| not ok
			#! msg
				= "Loaded type table " +++ toString type_table_i +++ ": " +++ tt_name;
			#! dl_client_state
				= AddMessage (LinkerError msg) dl_client_state;
			= (dl_client_state,io);
			
			
		# tt_pattern_matches
			= mapASt remove_types_without_definitions tio_common_defs []

		// create new type table
		# new_type_table
			= { default_type_table &
				tt_type_io_state		= type_io_state
			,	tt_tio_common_defs		= { x \\ x <-: tio_common_defs }
			,	tt_n_tio_common_defs	= size tio_common_defs
			,	tt_rti					= rti
			,	tt_pattern_matches		= { tt_pattern_match \\ tt_pattern_match <- tt_pattern_matches }
			};
		# dl_client_state
			= AddTypeTable type_table_i new_type_table dl_client_state;
			
		// print that type library has been loaded
		#! dl_client_state
			= AddMessage (Verbose ("Loaded type table " +++ toString type_table_i +++ ": " +++ tt_name)) dl_client_state;
		
		= (dl_client_state,io);
where {
	remove_types_without_definitions {tio_pattern_matches} s
		= remove_type_without_definition tio_pattern_matches s;
	where {
		remove_type_without_definition [] s
			= s;
		remove_type_without_definition [{tio_type_name_ref}:xs] s
			| isTypeWithoutDefinition tio_type_name_ref
				= s
				= remove_type_without_definition xs [tio_type_name_ref:s]
	};
};

LoadLibraryInstance_new :: !.Int !(Maybe [.DusLabel]) !*DLClientState !*f  -> *(!Int,[Int],*DLClientState,!*f) | FileEnv f;
LoadLibraryInstance_new library_instance_i (Just []) dl_client_state io
	= (0,[],dl_client_state,io);
LoadLibraryInstance_new library_instance_i labels_to_be_linked dl_client_state io
	# (dl_client_state,io)
		= initialize_predefined_type_equations library_instance_i dl_client_state io;
	# (dl_client_state,io)
		= initialize_internal_type_equivalence_classes library_instance_i dl_client_state io;

	#! (q,l,dl_client_state,io) 
		= load_code_library_instance labels_to_be_linked library_instance_i dl_client_state io;

	#! (n_type_implementations,dl_client_state)
		= dl_client_state!cs_type_implementation_table.teit_n_type_implementations;
		
	| COLLECTING_CONTEXT_TYPES
		= (q,l,dl_client_state,io);
		
		
		#! (/*unlinked_labels_of_types*/ _ ,dl_client_state,_,io)	
			= loopAst (enter_implicitly_linked_type_as_chosen_type_equivalent_class_implementation library_instance_i) ([],dl_client_state,1,io) n_type_implementations;
	
		= (q,l,dl_client_state,io);

	enter_implicitly_linked_type_as_chosen_type_equivalent_class_implementation library_instance_i type_implementation_i (unlinked_labels_of_types,dl_client_state,s,io)
		#! ({tei_type_implementations,tei_chosen_type_implementation},dl_client_state)
			= dl_client_state!cs_type_implementation_table.teit_type_implementations_a.[type_implementation_i];
		| isJust tei_chosen_type_implementation
			// a type has already been chosen and as a consequence also linked.
			= (unlinked_labels_of_types,dl_client_state,s,io);
			
		// determine whether the current library instance is member of the current type equivalent class (indicated by
		// library_instance_i) which has not yet an implementation. If the current library instance has multiple types
		// in the type equivalent class, then it should look also if one of these have already been linked.
		#! type_implementations
			= filter (\lit_type_ref -> 
				case lit_type_ref of {
					(LIT_TypeReference (LibRef offered_library_instance_i) _)
						-> library_instance_i == offered_library_instance_i;
					_
						-> False;
				}
			) tei_type_implementations;
			
		| isEmpty type_implementations
			// the current library instance does not contain a type from the type equivalent class
			= (unlinked_labels_of_types,dl_client_state,s,io);
			
			// a linked in type equivalent class *without* the chosen type implementation being entered in the type
			// implementation table. Enter the implicitly chosen implementation type.
			#! type_implementation
				= hd type_implementations;
				
			#! (implementation_is_available,dl_client_state)
				= isTypeImplemented type_implementation dl_client_state;

			| isNothing implementation_is_available				
				// the type has *not* been implicitly linked
				= (unlinked_labels_of_types,dl_client_state,s,io);
				
				#! (type_name,labels_implementing_type)
					= fromJust implementation_is_available;
				
				// ensure that the implementation of the type is loaded completely.
				#! remaining_unlinked_labels_implementing_type
					= [ {default_elem & 
							dusl_label_name = label_name
						,	dusl_library_instance_i = library_instance_i
						,	dusl_label_kind			= DSL_TYPE_EQUIVALENT_CLASS_IMPLEMENTATION
						} \\ label_name <- labels_implementing_type ];
				#! unlinked_labels_of_types
					= remaining_unlinked_labels_implementing_type ++ unlinked_labels_of_types;
					
				// make the chosen type the implementation type of the current equivalent class.
				#! (type_found,Just type_implementation_reference,dl_client_state)
					= findImplementationType type_implementation dl_client_state;
				| not type_found
					= abort "enter_implicitly_linked_type_as_chosen_type_equivalent_class_implementation; internal error";
					
				#! dl_client_state
					= enter_implementation_type_for_equivalence_class2 type_implementation_reference type_implementation dl_client_state;
			 		
				// print change
				#! msg
					= "type '" +++ type_name +++ "' has been implicitly linked from library instance #" +++ toString library_instance_i;
				#! dl_client_state
					= AddMessage (Verbose msg) dl_client_state;	
					
				#! dl_client_state
					= foldSt print_type_labels labels_implementing_type dl_client_state;   
					
				#! dl_client_state
					= print_type_implementation_table dl_client_state;
				= (unlinked_labels_of_types,dl_client_state,s,io);
	where {
		print_type_labels label_name dl_client_state
			#! (Just (file_n,symbol_n),dl_client_state)
				= findLabel label_name library_instance_i dl_client_state;
				
//			#! msg
//				= label_name +++ "<" +++ toString library_instance_i +++ ">   (file_n,symbol_n)" +++ toString file_n +++ "," +++ toString symbol_n;
//			#! dl_client_state
//				= AddMessage (Verbose msg) dl_client_state;	
			= dl_client_state;
		
		// predefined types without definitions (and DynamicTemp) all come from the main library instance.
		get_non_predefined_type (LIT_TypeReference _ tio_type_ref) //=:{tio_type_without_definition=Nothing})
			= tio_type_ref;
		
		check_whether_implementation_is_available label_name dl_client_state
			#! (Just (file_n,symbol_n),dl_client_state)
				= findLabel label_name library_instance_i dl_client_state;
			#! (maybe_address,dl_client_state)
				= isLabelImplemented file_n symbol_n dl_client_state;
			= (isJust maybe_address,dl_client_state);
	};

initialize_predefined_type_equations :: !.Int !*DLClientState *f -> *(*DLClientState,*f) | FileEnv f;
initialize_predefined_type_equations library_instance_i dl_client_state=:{cs_main_library_instance_i=xx,do_dump_dynamic} io
	// first call with library_instance_i; load type table for current instance, if necessary. The if can be omitted
	// after it turns out, the if-holds always.
	#! (type_table_i,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
	#! (dl_client_state,io)
		= LoadTypeTable type_table_i dl_client_state io;

	#! (li_initial_types_equivalences_entered,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_initial_types_equivalences_entered;
	| li_initial_types_equivalences_entered
		// The type table has already been loaded and the initial type equivalences have already
		// been established at the first call with the current library_instance_i.
		= (dl_client_state,io);
			
	// mark it
	#! dl_client_state
		= { dl_client_state & cs_library_instances.lis_library_instances.[library_instance_i].li_initial_types_equivalences_entered = True };


	// type available ...
	#! (tt_n_tio_common_defs,dl_client_state)
		= dl_client_state!cs_type_tables.[type_table_i].tt_n_tio_common_defs;

	# (n_library_instances,dl_client_state)
		= dl_client_state!cs_library_instances.lis_n_library_instances;
	# (dl_client_state,io)
		= case ((n_library_instances - RTID_LIBRARY_INSTANCE_ID_START) < 2) of {
			True
				-> (dl_client_state,io);
			False
				#! msg
					= "	initialize_predefined_type_equations " +++ toString library_instance_i;
				#! dl_client_state
					= AddMessage (Verbose msg) dl_client_state;

				#! cs_main_library_instance_i
					= RTID_LIBRARY_INSTANCE_ID_START;
				// all other dynamics must communicate with the application, so they all need to agree on 
				// at least a single representation for Dynamics and the types of dynamics. There is only
				// one choice, taking the implementation of the application because it is loaded and linked
				// first.
				# dynamicje
					= { 
						tr_type_name	= DynamicRepresentation_String
					,	tr_module_name1	= UnderscoreSystemDynamicModule_String
					,	tr_module_name2	= UnderscoreSystemDynamicModule_String
					,	tr_library2		= Number cs_main_library_instance_i 	// will be 2nd arg of enter_type_equation
					,	tr_library1		= Number library_instance_i				// RunTimeID (not diskID)
					};
					
				// graph_to_string-instances must share a single LazyDynamicReference
				# lazy_dynamic_reference
					= { 
						tr_type_name	= LazyDynamicReference_String
					,	tr_module_name1	= StdDynamicLowLevelInterfaceModule_String
					,	tr_module_name2	= StdDynamicLowLevelInterfaceModule_String
					,	tr_library2		= Number cs_main_library_instance_i 	// will be 2nd arg of enter_type_equation
					,	tr_library1		= Number library_instance_i				// RunTimeID (not diskID)
					};

				# global_dynamic_info_dummy
					= { 
						tr_type_name	= GlobalDynamicInfoDummy_String
					,	tr_module_name1	= UnderscoreSystemDynamicModule_String
					,	tr_module_name2	= UnderscoreSystemDynamicModule_String
					,	tr_library2		= Number cs_main_library_instance_i 	// will be 2nd arg of enter_type_equation
					,	tr_library1		= Number library_instance_i				// RunTimeID (not diskID)
					};
					
				# run_time_idw
					= { 
						tr_type_name	= RunTimeIDW_String
					,	tr_module_name1	= DynamicLinkerInterfaceModule_String
					,	tr_module_name2	= DynamicLinkerInterfaceModule_String
					,	tr_library2		= Number cs_main_library_instance_i 	// will be 2nd arg of enter_type_equation
					,	tr_library1		= Number library_instance_i				// RunTimeID (not diskID)
					};

				// The predefined types defined in the run-time system are shared among all library instances because it
				// is/will be used by all library instances, if necessary.
				// main library instance provides the implementation
				#! (ok,dl_client_state,io)
					= CheckAndEnterType [dynamicje/*,realtje*/,lazy_dynamic_reference,global_dynamic_info_dummy,run_time_idw] (Just cs_main_library_instance_i) dl_client_state io;
				| not ok
					-> abort "internal/external error; representation of dynamics has changed";

				#! (cs_n_fixed_available_types,dl_client_state)
					= dl_client_state!cs_n_fixed_available_types;
				#! (dl_client_state,io)
					= case cs_n_fixed_available_types of {
						Nothing
							// it is assumed that a type equivalent class which already has an implementation i.e.
							// the type implementation has been linked, is marked as such in the available array
							// below.
							#! (teit_n_type_implementations,dl_client_state)
								= dl_client_state!cs_type_implementation_table.teit_n_type_implementations;
							#! li_type_available
								= createArray teit_n_type_implementations True;
							#! dl_client_state
								= { dl_client_state & 
									cs_library_instances.lis_library_instances.[cs_main_library_instance_i].li_s_type_available = teit_n_type_implementations
								,	cs_library_instances.lis_library_instances.[cs_main_library_instance_i].li_type_available = li_type_available
								};
							#! dl_client_state
								= { dl_client_state &
									cs_n_fixed_available_types	= Just teit_n_type_implementations };

							// a type implementation for a particular type equivalent class has been implemented if
							// *all* of the labels implementing the type have been linked.

							#! dl_client_state
								= print_type_implementation_table dl_client_state;

							-> (dl_client_state,io);
						Just _
							-> (dl_client_state,io);
					};
					
				// internal types moeten ook nog and basic types
				-> (dl_client_state,io);
		};
		
		
	= (dl_client_state,io);
where {
	// communication is done by dynamics. So the DynamicTemp and its type (and further types it depends upon)
	// must at the very least be constructible e.i. there exists a correctly typed Clean graph. The value may
	// not be (this depends on the type which describes the value). Here it is ensure that *all* labels which
	// implement the DynamicTemp-type are linked in.
	// Furthermore predefined types e.g. ints, reals, lists, etc. are also shared by all library instances.
}
					
// old behaviour = create_new_names_table set to True
read_type_library_new :: !Bool !String *Files -> *(*(Bool,RTI,.{#TIO_CommonDefs},*TypeIOState,*{!NamesTableElement}),*Files);	
read_type_library_new create_new_names_table ls_main_code_type_lib files
	| create_new_names_table
		# (ok,rti,tio_common_defs,type_io_state,names_table,files)
			= read_type_information (ADD_TYPE_LIBRARY_EXTENSION ls_main_code_type_lib) create_names_table files;
		= ((ok,rti,tio_common_defs,type_io_state,names_table),files);

		// to prevent a names table being created and filled		
		# (ok,rti,tio_common_defs,type_io_state,names_table,files)
			= read_type_information_new create_new_names_table (ADD_TYPE_LIBRARY_EXTENSION ls_main_code_type_lib) {} files;
		= ((ok,rti,tio_common_defs,type_io_state,names_table),files);