implementation module ObjectToMem;

import
	StdEnv;
	
import UnknownModuleOrSymbol;

import SearchObject;
import ExtFile;
import ExtInt;
import DynamicLink;
F a b :== b;

import CommonObjectToDisk;
import pdObjectToMem;
from xcoff import SIZE_OF_RELOCATION;
import CollectTypes;
from utilities import mapSt;
import link_switches;

//1.3
from ReadObject import read_library_file, ExtFileSystem, read_library_file_new;
from deltaIOState import FileEnv;
import what_linker;
//3.1
/*2.0
from ReadObject import read_library_file, class ExtFileSystem, instance ExtFileSystem Files, read_library_file_new;
import what_linker;
from pdObjectToMem import instance SendAddressToClient Int;
0.2*/

import xcoff;

LinkUnknownSymbols :: [ModuleOrSymbolUnknown] !*State !Int !*DLClientState *f -> *(*(!(Maybe WriteImageInfo),[Int],!*State,!*DLClientState),*f) | FileEnv f;
LinkUnknownSymbols unknown_modules_or_symbols state library_instance_i dl_client_state io
//	| True <<- ("LinkUnknownSymbols",unknown_modules_or_symbols)
/*
	// test
	#! (qd_file_n,qd_symbol_n,state)
		= find_name "qd" state;
	| F ("file_n: " +++ toString qd_file_n +++ " - symbol_n:" +++ toString qd_symbol_n) True
*/

	/*
	** unknown_symbols contains those symbols that have not been yet been
	** placed into memory. Only these symbols should be loaded and linked.
	*/
	#! (unknown_symbols,state)
		= mapSt compute_file_n_symbol_n_for_symbol unknown_modules_or_symbols state;
	with {
		compute_file_n_symbol_n_for_symbol (SymbolUnknown _ symbol_name) state
			#! (file_n,symbol_n,state)
				= find_name symbol_name state;
			= ((file_n,symbol_n),state);
	};
				
	#! (base_address,wii,state,dl_client_state,io)
		= link_unknown_symbols unknown_symbols state library_instance_i dl_client_state io;
	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= abort "error"; //((wii,[],state),io);
		
	/*
	** The address of all unknown symbols, if defined are encoded as a
	** string and returned *in the order* as in the unknown_modules_or_symbols
	** parameter. The conversion function uses the order to identify the
	** proper descriptor.
	*/ 
	#! (_,symbol_addresses,state)
		= foldl compute_symbol_address (base_address,[],state) unknown_modules_or_symbols
	= ((wii,symbol_addresses,state,dl_client_state),io);
where {				
	compute_symbol_address (base_address,symbol_addresses,state) symbol
		#! symbol_name
			= extract_symbol_name symbol;
		| symbol_name == ""
			= (base_address,symbol_addresses,state);
			
			#! (file_n,symbol_n,state)
				= find_name symbol_name state;
			#! (symbol_address,state)
				= address_of_label2 file_n symbol_n state;
				
			= (base_address,symbol_addresses ++ [ base_address + symbol_address],state);
			
	extract_symbol_name (ModuleUnknown _ symbol_name)
		= symbol_name;
	extract_symbol_name (SymbolUnknown  _ symbol_name )  //symbol_name _)
		= symbol_name;
	extract_symbol_name _ 
		= abort "extract_symbol_name: no match";
}

/*
** MAC
from ExtLibrary import Toolbox, GetToolBox;
from pointer import LoadByte, StoreByte, Ptr;
*/
/*
*/	

/*
MOVED TO: selectively_import_and_mark_labels
replace_section_label_by_label2 :: !Int !Int !*State -> (!Int,!*State);
replace_section_label_by_label2 file_n symbol_n state
	#! (symbol,state) 
		= state!xcoff_a.[file_n].symbol_table.symbols.[symbol_n];
	= replace_section_label_by_label symbol file_n symbol_n state;

replace_section_label_by_label :: !Symbol !Int !Int !*State -> (!Int,!*State);
replace_section_label_by_label (SectionLabel section_n label_offset) file_n symbol_n state
	#! (section_symbol_n,state)
		= state!xcoff_a.[file_n].symbol_table.section_symbol_ns.[section_n];
	| section_n >= 1 && section_symbol_n <> (-1)
		#! state
			= { state & 
				xcoff_a.[file_n].symbol_table.symbols.[symbol_n] = Label section_n label_offset section_symbol_n
			};
		= (section_symbol_n,state);

selective_import_symbol :: !Int !Int !*(!*{#Bool},!*State) -> *(!*{#Bool},!*State);
selective_import_symbol file_n symbol_n (newly_marked_bool_a,state)
	#! (symbol_offset,state)
		= symbol_n_to_offset file_n symbol_n state;
	#! (marked_symbol,state)
		= state!marked_bool_a.[symbol_offset];
	| marked_symbol || newly_marked_bool_a.[symbol_offset]
		// has already been marked
		= (newly_marked_bool_a,state);


	// unmarked symbol
	#! newly_marked_bool_a
		= { newly_marked_bool_a & [symbol_offset] = True };
	| file_n < 0
		= (newly_marked_bool_a,state);
		
	#! (symbol,state) 
		= state!xcoff_a.[file_n].symbol_table.symbols.[symbol_n];

	= selective_symbol_import2 symbol file_n symbol_n (newly_marked_bool_a,state);
where {
	selective_symbol_import2 symbol=:(SectionLabel section_n label_offset) _ _ (newly_marked_bool_a,state)
		#! (section_symbol_n,state)
			= replace_section_label_by_label symbol file_n symbol_n state;
		= selective_import_symbol file_n section_symbol_n (newly_marked_bool_a,state);

	selective_symbol_import2 (Module c1 length virtual_address c2 n_relocations relocations) _ _ s
		= loopAst selective_module_symbol_import s n_relocations;
	where {
		selective_module_symbol_import relocation_n (newly_marked_bool_a,state)
			#! relocation_index
				= relocation_n * SIZE_OF_RELOCATION;
			#! relocation_type
				= relocations IWORD (relocation_index+8);
			#! relocation_symbol_n
				= relocations ILONG (relocation_index+4);
			#! relocation_offset
				= relocations ILONG relocation_index;
				
			# (newly_marked_bool_a,state)
				= what_linker (newly_marked_bool_a,state) (case (((relocation_offset-virtual_address) + 4) == length) of {
					// copy&paste from mark_used_modules (pdSymbolTable)
					// when will this jump be inserted?
					_ 
						-> (newly_marked_bool_a,state);
					
					True
						#! (symbol_offset,state)
							= symbol_n_to_offset file_n relocation_symbol_n state;
						#! (marked_symbol,state)
							= state!marked_bool_a.[symbol_offset];
						| marked_symbol && relocation_type == REL_ABSOLUTE
					/*
						#! module_n
							= symbol_n;		
						#! (first_symbol_n, marked_offset_a) 
							= marked_offset_a![file_n];
						#! bool_offset
							=first_symbol_n + relocation_symbol_n;
						|  already_marked_bool.[bool_offset] //&& relocation_type == REL_ABSOLUTE
							// There is a reference from an (yet) unlinked module to another already linked module. If the unlinked
							// module does not contain an jump instruction at its end, one has to be generated. Accessing the file
							// is expensive. Therefore the worst is assumed: there is a non-jump in which case one has to be 
							// generated.
							/*
							#! updated_relocations
								= WriteLong { c \\ c <-: relocations} relocation_index (relocation_offset + 5) +++ "1"; 
								
							#! updated_module_symbol
								= Module c1 (length + 5) virtual_address c2 /*(inc n_relocations)*/ n_relocations updated_relocations;
							*/
							
							#! (module_name,xcoff_a)
								= xcoff_a![file_n].module_name;
							
							/*			
							#! xcoff_a
								= upd_symbol updated_module_symbol file_n module_n xcoff_a;
							*/
							| relocation_type == REL_ABSOLUTE
								// in this case an extra jump should be generated because the module does not end on one. The
								// relocation type should probably be changed into REL_REL32. The above code should be valid.
								-> abort "pdSymbolTable: jmp problem; please report immediately martijnv@cs.kun.nl";
							
								-> F ("<"+++ module_name +++">danger (if not jmp): file_n: " +++ toString file_n +++ " module_n: " +++ hex_int module_n +++ " - " +++ hex_int relocation_symbol_n) (marked_offset_a,xcoff_a);
							-> F ("!potential danger: file_n: " +++ toString file_n +++ " module_n: " +++ hex_int module_n +++ " - " +++ hex_int relocation_symbol_n) (marked_offset_a,xcoff_a);				
				*/
							-> abort "DynamicLinker; ObjectToMem; internal error";
							-> (newly_marked_bool_a,state);
										
					_
						-> (newly_marked_bool_a,state); 
						
				
					}
				);

			= selective_import_symbol file_n relocation_symbol_n (newly_marked_bool_a,state);
	};
	
	selective_symbol_import2 (ImportLabel label_name) import_label_file_n import_label_symbol_n (newly_marked_bool_a,state)
		#! (imported_symbol_found,imported_file_n,imported_symbol_n,state)
			= find_name4 label_name state;
		| imported_symbol_found // <<- ("selective_symbol_import2", label_name)
			#! state
				= { state & 
					xcoff_a.[import_label_file_n].symbol_table.symbols.[import_label_symbol_n] 
					= ImportedLabel imported_file_n imported_symbol_n
				};

			// ImportedLabel is immediately replaced by a SectionLabel or Label
			= import_an_import_label imported_file_n imported_symbol_n import_label_file_n import_label_symbol_n (newly_marked_bool_a,state);
			
			// import_symbols (pdSymbolTable)
			= abort ("imported label '" +++ label_name +++ "' not found");
	
	selective_symbol_import2 (ImportedLabel imported_file_n imported_symbol_n) import_label_file_n import_label_symbol_n (newly_marked_bool_a,state)
		= import_an_import_label imported_file_n imported_symbol_n import_label_file_n import_label_symbol_n (newly_marked_bool_a,state);


	selective_symbol_import2 (ImportedLabelPlusOffset imported_file_n imported_symbol_n _) _ _ s
		= selective_import_symbol imported_file_n imported_symbol_n s;

	selective_symbol_import2 (ImportedFunctionDescriptor imported_file_n imported_symbol_n) _ _ s
		= selective_import_symbol imported_file_n imported_symbol_n s;
};

import_an_import_label /* symbol to be imported */ imported_file_n imported_symbol_n /* import site */ import_label_file_n import_label_symbol_n (newly_marked_bool_a,state)
	| imported_file_n < 0
		= selective_import_symbol imported_file_n imported_symbol_n (newly_marked_bool_a,state);
	#! state
		= replace_imported_label_symbol /* symbol to be imported */ imported_file_n imported_symbol_n /* import site */ import_label_file_n import_label_symbol_n state;
	= selective_import_symbol imported_file_n imported_symbol_n (newly_marked_bool_a,state);
where {
	replace_imported_label_symbol /* symbol to be imported */ imported_file_n imported_symbol_n /* import site */ import_label_file_n import_label_symbol_n state
		#! (imported_symbol,state) 
			= state!xcoff_a.[imported_file_n].symbol_table.symbols.[imported_symbol_n];
		#! state
			= case imported_symbol of {
				SectionLabel section_n v_label_offset
					#! (section_symbol_n,state)
						= state!xcoff_a.[imported_file_n].symbol_table.section_symbol_ns.[section_n];
					#! (module_symbol,state) 
						= state!xcoff_a.[imported_file_n].symbol_table.symbols.[section_symbol_n];
					-> case module_symbol of {
						Module v_module_offset _ _ _ _ _
							#! state
								= { state & 
									xcoff_a.[import_label_file_n].symbol_table.symbols.[import_label_symbol_n] 
									= ImportedLabelPlusOffset imported_file_n section_symbol_n (v_label_offset-v_module_offset)
								};
							-> state;
						_
							-> state;
						};
				Label _ v_label_offset module_n
				//	at an earlier point in time, mark_used_modules has already converted a Section-
				//	Label into a Label. Re-implements a part of the SectionLabel-case.
					#! (module_symbol,state) 
						= state!xcoff_a.[imported_file_n].symbol_table.symbols.[module_n];
					-> case module_symbol of {
						Module v_module_offset _ _ _ _ _
							#! state
								= { state & 
									xcoff_a.[import_label_file_n].symbol_table.symbols.[import_label_symbol_n] 
									= ImportedLabelPlusOffset imported_file_n module_n (v_label_offset-v_module_offset)
								};
							-> state;
						_
							-> state;
						};	
				_ 
					-> state;
			};
		= state;
}; // import_an_import_label

*/

import selectively_import_and_mark_labels;
// ------------------
from utilities import foldSt;

import DLState;

move_names_table_from_library_instance_i_to_state library_instance_i dl_client_state
	// move namestable from library_instance to current state
	#! (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
		};
	= (state,dl_client_state);
	
move_names_table_from_state_to_library_instance_i library_instance_i state dl_client_state
	#! (names_table,state)
		= select_namestable state;
	#! dl_client_state
		= { dl_client_state &
			app_linker_state = state
		,	cs_library_instances.lis_library_instances.[library_instance_i].li_names_table = names_table
			};		
	= dl_client_state;


//link_unknown_symbols :: ![(.Int,.Int)] *State *(IOState *a) -> *(Int,!WriteImageInfo,*State,*IOState *a);
link_unknown_symbols [] state library_instance_i dl_client_state io
	= (0,Nothing /*default_write_image_info*/,state,dl_client_state,io);		
link_unknown_symbols unknown_symbols state=:{n_xcoff_symbols,n_library_symbols,library_list,n_libraries,n_xcoff_files,one_pass_link} library_instance_i dl_client_state io
//	| False <<- ("link_unknown_symbols; (initial symbols)", unknown_symbols)
//		= undef;

	#! newly_marked_bool_a
		= createArray (n_xcoff_symbols + n_library_symbols) False;
		
//	| False <<- ("start - marking", unknown_symbols)
//		= undef;
	#! (newly_marked_bool_a,state)
		= foldSt (\(file_n,symbol_n) s -> selective_import_symbol file_n symbol_n s) unknown_symbols (newly_marked_bool_a,state);
//	| False <<- ("end - marking")
//		= undef;

	// ensure that all needed prefixes are linked ...
	#! (context_types,newly_marked_bool_a,state,dl_client_state,io)
		= case (library_instance_i < 0) of {
			True
				// a hack to load in the conversion functions which are
				// added to names table of the main library instance.
				-> ([],newly_marked_bool_a,state,dl_client_state,io);
			False
				#! dl_client_state
					= move_names_table_from_state_to_library_instance_i library_instance_i state dl_client_state;
				#! (context_types,_,(newly_marked_bool_a,dl_client_state,io))
					= loop_on_types library_instance_i (newly_marked_bool_a,dl_client_state,io);

				#! (state,dl_client_state)
					= move_names_table_from_library_instance_i_to_state library_instance_i dl_client_state;
				-> (context_types,newly_marked_bool_a,state,dl_client_state,io);
		};
		
	#! (already_marked_bool_a,state)
		= select_marked_bool_a state;
	#! state
		= { state &
			marked_bool_a	= newly_marked_bool_a
		};
		
	
	#! (base_address,wii,state,io)
		= write_image state io;

/*		
	// TEST
	#! (file_n,symbol_n,state)
		= find_name "qd" state;
		
	// mark qd-symbol
	#! (file_n_offset,state)
		= selacc_marked_offset_a file_n state;
	
	#! (dest_qd_address,state)
		= selacc_module_offset_a (file_n_offset + symbol_n) state;
		
		
	#! (toolbox,io)
		= GetToolBox io;
	#! toolbox
		= copy_mem qd_address 206 dest_qd_address toolbox;
		
	#! io
		= PutToolBox toolbox io;
*/		
	
/*
	// test
	#! (qd_address,state)
		= acc_pd_state (\pd_state=:{qd_address} -> (qd_address,pd_state)) state;
	#! state
		= F ("qd_address(3): " +++ (hex_int qd_address)) state;
*/

	// merge previous and new marked symbols
	#! (marked_bool_a,state)
		= select_marked_bool_a state;
		
//	| False <<- ("or_bool_arrays")
//		= undef;
	#! all_marked_bool_a
		= or_bool_arrays marked_bool_a already_marked_bool_a;	
	#! state
		= {state & marked_bool_a = all_marked_bool_a};
	
	#! dl_client_state
		= move_names_table_from_state_to_library_instance_i library_instance_i state dl_client_state;

//	| False <<- ("Fix_context_implementation")
//		= undef;
	#! (dl_client_state,io)
		= foldSt fix_context_implementation context_types (dl_client_state,io);
		
	#! (state,dl_client_state)
		= move_names_table_from_library_instance_i_to_state library_instance_i dl_client_state;

	= (base_address,Just wii,state,dl_client_state,io);
	where {
		fix_context_implementation (type_name,type,type_equivalent_class_reference) (dl_client_state,io)
			#! (_,dl_client_state,io)
				= enter_type_equation_new [type] dl_client_state io;
				
			#! msg
				= "fixed implementation type for class '" +++ type_name +++ "' with index " +++ toString type_equivalent_class_reference;
			#! dl_client_state
				= AddMessage (Verbose msg) dl_client_state;
			= (dl_client_state,io);
/*
		copy_mem qd_address i dest_qd_address toolbox
			| i == 0
				= toolbox;
				
				#! (v,toolbox)
					= LoadByte qd_address toolbox;
				#! toolbox
					= StoreByte dest_qd_address v toolbox;
				= copy_mem (inc qd_address) (dec i) (dec dest_qd_address) toolbox;
*/
	
}

or_bool_arrays marked_bool_a2 marked_bool_a = { b1 || b2 \\ b1<-:marked_bool_a2 & b2<-:marked_bool_a };
	
ReadLibraryFiles2 :: ![String] !Int !Int !NamesTable !*Files -> ((!Bool,!LibraryList,!Int,!NamesTable),!*Files);
ReadLibraryFiles2 l library_n n_library_symbols0 names_table0 files0
	#! (b,l,i,f,n)
		= ReadLibraryFiles l library_n n_library_symbols0 files0 names_table0;
	= ((b,l,i,n),f);
	
	ReadLibraryFiles :: ![String] !Int !Int !*Files !NamesTable -> (!Bool,!LibraryList,!Int,!*Files,!NamesTable);
	ReadLibraryFiles [] library_n n_library_symbols0 files0 names_table0
		= (True,EmptyLibraryList,n_library_symbols0,files0,names_table0);
	ReadLibraryFiles [file_name:file_names] library_n n_library_symbols0 files0 names_table0
		#! (ok1,library_name,library_symbols,n_library_symbols,files1,names_table1)
			= read_library_file file_name library_n files0 names_table0;
		| ok1
			#! (ok10,libraries,n_library_symbols1,files2,names_table2)
				= ReadLibraryFiles file_names (inc library_n) (n_library_symbols0+n_library_symbols) files1 names_table1;		
			= (ok10,Library library_name /* mac */ 0 library_symbols n_library_symbols libraries,n_library_symbols1,files2,names_table2);
			
			= abort ("ReadLibraryFiles2: could not read '" +++ file_name +++ "'");

// It is assumed that a library instance is only loaded once which implies that if the library instance implements some
// type, then all its labels implementing that type must have been linked. The initial marking just marks the symbols
// reachable from set of root symbols. In general label prefixes may not refer to eachother, so they have to be marked
// explicitly. This function carries out this task.
// Vraag: Kunnen we niet gewoon alleen over de externe types lopen? Of over alle pattern gematchte types?
//loop_on_types :: !.Int !*(*{#.Bool},!*DLClientState,*a) -> *([(!{#Char},!LibraryInstanceTypeReference,!Int)],[.b],*(.{#Bool},*DLClientState,*a)) | FileEnv a;
loop_on_types library_instance_i (newly_marked_bool_a,dl_client_state=:{cs_main_library_instance_i},io)
	// general
	#! (type_table_i,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
	#! (tt_n_tio_common_defs,dl_client_state)
		= dl_client_state!cs_type_tables.[type_table_i].tt_n_tio_common_defs;

	#! (context_types,labels,newly_marked_bool_a,dl_client_state,io)
		= loopAst (loop_on_module type_table_i) ([],[],newly_marked_bool_a,dl_client_state,io) tt_n_tio_common_defs;
	= (context_types,labels,(newly_marked_bool_a,dl_client_state,io));

where {
	loop_on_module type_table_i tio_tr_module_n (context_types,labels,newly_marked_bool_a,dl_client_state,io)
		// loop on type definitions
		# (tio_com_type_defs,dl_client_state)
			= dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_type_defs;
		# (context_types,labels,newly_marked_bool_a,dl_client_state,io)
			= mapAiSt loop_on_type_def tio_com_type_defs (context_types,labels,newly_marked_bool_a,dl_client_state,io);
		= (context_types,labels,newly_marked_bool_a,dl_client_state,io);
	where {
		// Determine which label prefixes have not yet been linked in. 
		loop_on_type_def tio_tr_type_def_n {tio_td_name} (context_types,labels,newly_marked_bool_a,dl_client_state,io)
			# tio_type_reference
				= { default_elem &
					tio_tr_module_n		= tio_tr_module_n
				,	tio_tr_type_def_n	= tio_tr_type_def_n
				};
			# type
				= LIT_TypeReference (LibRef library_instance_i) tio_type_reference;

			#! (li_type_table_i,dl_client_state)
				= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
			#! (type_name,_,labels_implementing_type,dl_client_state)
				= get_type_label_names tio_type_reference li_type_table_i dl_client_state;
				
				
			| True // IS_CONSTRUCTOR_SHARING
				#! (any_label_implemented,unlinked_labels,newly_marked_bool_a,dl_client_state)
					= foldSt any_label_implemented labels_implementing_type (False,[],newly_marked_bool_a,dl_client_state);
				| not any_label_implemented 
					// type not about to be linked
					= (context_types,labels,newly_marked_bool_a,dl_client_state,io);
						
					#! (x,dl_client_state)
						= mapSt find_file_n_and_symbol_n labels_implementing_type dl_client_state;
						with {
							find_file_n_and_symbol_n label_name dl_client_state
								# (maybe_file_n_symbol_n,dl_client_state)
									= findLabel label_name library_instance_i dl_client_state;
								| isNothing maybe_file_n_symbol_n
									= abort "find_file_n_and_symbol_n; internal error";
									
								# (file_n_symbol_n=:(file_n,symbol_n))
									= fromJust maybe_file_n_symbol_n;

								= ((label_name,file_n,symbol_n),dl_client_state);
						};
						
					// type about to be linked			
					#! (maybe_reference,dl_client_state,io)
						= enter_type_equation_new [type] dl_client_state io;
					| isNothing maybe_reference
						// link it because no equivalent type class i.e. single type implementation
						#! (newly_marked_bool_a,dl_client_state)
							= close_type_implementation /* unlinked_labels*/ x newly_marked_bool_a dl_client_state
						= (context_types,labels,newly_marked_bool_a,dl_client_state,io);

						// there is a type equivalent class 
						#! (type_equivalent_class_reference,_)
							= fromJust maybe_reference;
						#! ({tei_chosen_type_implementation},dl_client_state)
							= dl_client_state!cs_type_implementation_table.teit_type_implementations_a.[type_equivalent_class_reference];
						| isJust tei_chosen_type_implementation
							// with implementation
							#! message
								= "TYPE EQUIVALENT CLASS WITH IMPL";
							#! dl_client_state 
								= AddMessage (Verbose message) dl_client_state
								
							#! (newly_marked_bool_a,dl_client_state)
								= unmark_type_implementation x newly_marked_bool_a dl_client_state;
							= (context_types,labels,newly_marked_bool_a,dl_client_state,io);

							// without implementation
							#! (newly_marked_bool_a,dl_client_state)
								= close_type_implementation /*unlinked_labels*/ x newly_marked_bool_a dl_client_state
							#! context_types
								= [(type_name,type,type_equivalent_class_reference):context_types];
							= (context_types,labels,newly_marked_bool_a,dl_client_state,io);
				
				// closure on type implementation
				#! (any_label_implemented,unlinked_labels,newly_marked_bool_a,dl_client_state)
					= foldSt any_label_implemented labels_implementing_type (False,[],newly_marked_bool_a,dl_client_state);
				# (context_types,dl_client_state,io)
					= case any_label_implemented of {
						True	-> is_context_type type_name type context_types dl_client_state io;
						_		-> (context_types,dl_client_state,io);
					};
				| any_label_implemented && not (isEmpty unlinked_labels)
	//				| True <<- ("!",type_name,labels_implementing_type,any_label_implemented)
	//					= abort "saa"
				
					// at least one label but not all labels have been implemented for the type. The other should be marked
					// too. If partially linked type are supported in the future, then this code is no longer necessary.
					// reachable types ... types dependent on the current type are *not* reachable from the type.
					# (type_tables,dl_client_state)
						= get_type_tables dl_client_state;
					# type
						= (TypeTableTypeReference li_type_table_i 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};
					
						
					// convert to names
					# (cts_type_dependencies2,type_tables)
						= mapSt (\(tio_type_reference,_) type_tables -> print_type_table_reference li_type_table_i tio_type_reference type_tables) cts_type_dependencies type_tables;
						
					# dl_client_state
						= { dl_client_state &
							cs_type_tables = type_tables
						};	
					# (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state)
						= foldSt detect_unlinked_but_reachable_labels_of_types cts_type_dependencies (unlinked_labels,newly_marked_bool_a,dl_client_state);
					# unlinked_labels
						= unlinked_but_reachable_labels_of_types;
					// ... reachable types
	
					#! (state,dl_client_state)
						= move_names_table_from_library_instance_i_to_state library_instance_i dl_client_state;
//					| False <<- ("marking more")
//						= undef;
					#! (newly_marked_bool_a,state)
						= foldSt (\(_,(file_n,symbol_n)) s -> selective_import_symbol file_n symbol_n s) unlinked_labels (newly_marked_bool_a,state);
					#! dl_client_state
						= move_names_table_from_state_to_library_instance_i library_instance_i state dl_client_state;
					= (context_types,labels,newly_marked_bool_a,dl_client_state,io);
		
					= (context_types,labels,newly_marked_bool_a,dl_client_state,io);
		// huidige library instance bevat al een gedeeltelijk implementation van het type				
		where {
			close_type_implementation labels newly_marked_bool_a dl_client_state
				#! (state,dl_client_state)
					= move_names_table_from_library_instance_i_to_state library_instance_i dl_client_state;
				#! (newly_marked_bool_a,state)
//					= foldSt (\(_,(file_n,symbol_n)) s -> selective_import_symbol file_n symbol_n s) labels (newly_marked_bool_a,state);
					= foldSt (\(_,file_n,symbol_n) s -> selective_import_symbol file_n symbol_n s) labels (newly_marked_bool_a,state);

				#! dl_client_state
					= move_names_table_from_state_to_library_instance_i library_instance_i state dl_client_state;
				= (newly_marked_bool_a,dl_client_state);
				
			unmark_type_implementation labels newly_marked_bool_a dl_client_state
				# (newly_marked_bool_a,dl_client_state)
					= foldSt unmark_constructor_label labels (newly_marked_bool_a,dl_client_state);
//				| False <<- ("unmark_type_implementation", labels)
//					= undef;
					
				= (newly_marked_bool_a,dl_client_state);
			where {
				unmark_constructor_label (constructor_label_name,file_n,symbol_n) /*constructor_label_name*/ (newly_marked_bool_a,dl_client_state)
					# (symbol_index,dl_client_state)
						= symbol_n_to_offset file_n symbol_n dl_client_state;

				
					// check ...
					#! (is_newly_marked_label,newly_marked_bool)
						= newly_marked_bool_a![symbol_index];
					| not is_newly_marked_label //<<- (file_n,symbol_n,library_instance_i) 
						// labels for constructors of a type which are not linked
						= (newly_marked_bool_a,dl_client_state);
	
						#! (is_marked_label,newly_marked_bool)
							= dl_client_state!app_linker_state.marked_bool_a.[symbol_index];
						| is_marked_label
							#! (ref_module_n,dl_client_state)
								= acc_state (replace_section_label_by_label2 file_n symbol_n) dl_client_state;
							# (module_index,dl_client_state)
								= symbol_n_to_offset file_n ref_module_n dl_client_state;
							
							// note that not everything is unmarked; only the constructor. The rest could be unmarked
							// iff it is not shared but this is costly to determine and only a few bytes are extra
							// allocated (probably those for the module_name).
							#! newly_marked_bool_a
								= { newly_marked_bool_a & [symbol_index] = False, [module_index] = False };
							#! (s_newly_marked_bool_a,newly_marked_bool_a)
								= usize newly_marked_bool_a;
								
							| False //<<- ("unmarked: ", s_newly_marked_bool_a, file_n, symbol_n, file_n,ref_module_n,[(y,x) \\ x <-: dl_client_state.app_linker_state.marked_offset_a & y <- [0..210] ])
								= undef;
								// DLClientState
								
					
													
							= (newly_marked_bool_a,dl_client_state);

							// replaceLabel should already have marked this
							= abort "unmark_constructor_label; internal error";
					
					// ... check
// replaceLabel					
					
			
			
			};
												
			is_context_type :: !String !LibraryInstanceTypeReference [(!String,!LibraryInstanceTypeReference,!Int)] !*DLClientState !*f -> ([(!String,!LibraryInstanceTypeReference,!Int)],!*DLClientState,!*f) | FileEnv f;
			is_context_type type_name searched_type=:(LIT_TypeReference (LibRef library_instance_i) tio_type_reference) context_types dl_client_state io
				#! (maybe_reference,dl_client_state,io)
					= enter_type_equation_new [searched_type] dl_client_state io;
				| isNothing maybe_reference
					= (context_types,dl_client_state,io);
					
					#! (type_equivalent_class_reference,_)
						= fromJust maybe_reference;
					#! ({tei_chosen_type_implementation},dl_client_state)
						= dl_client_state!cs_type_implementation_table.teit_type_implementations_a.[type_equivalent_class_reference];
					| isJust tei_chosen_type_implementation
						// The type equivalent class has already been implemented. Then all the labels of its
						// constructor(s) should have been linked which contradicts the fact that are still
						// unlinked labels left. (see context of function call)
						= abort "is_part_of_external_type; internal error; class has already been implemented";
						
						= ([(type_name,searched_type,type_equivalent_class_reference):context_types],dl_client_state,io);

			detect_unlinked_but_reachable_labels_of_types ({tio_type_without_definition=Just _},_) (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state)
				// a type without definition is assumed to be linked
				= (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state);

			detect_unlinked_but_reachable_labels_of_types (tio_type_reference,_) (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state)
				# type
					= LIT_TypeReference library_instance_i tio_type_reference;
	
				#! (li_type_table_i,dl_client_state)
					= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
				#! (type_name,_,labels_implementing_type,dl_client_state)
					= get_type_label_names tio_type_reference li_type_table_i dl_client_state;
	
				#! (any_label_implemented,unlinked_labels,newly_marked_bool_a,dl_client_state)
					= foldSt any_label_implemented labels_implementing_type (False,[],newly_marked_bool_a,dl_client_state);
				| any_label_implemented
					= (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state);
					
//				#! dl_client_state 
//					= dl_client_state <<- ("detect_unlinked_but_reachable_labels_of_types",unlinked_labels);
				#! unlinked_but_reachable_labels_of_types
					= unlinked_labels ++ unlinked_but_reachable_labels_of_types;
				= (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state);
				
			// at_least_one_label_of_type_is_about_to_be_implemented_by_current_library
			any_label_implemented label_name (any_label_implemented,unimplemented_labels,newly_marked_bool,dl_client_state)
				# (maybe_file_n_symbol_n,dl_client_state)
					= findLabel label_name library_instance_i dl_client_state;
				| isNothing maybe_file_n_symbol_n
					# dl_client_state
						= OUTPUT_UNIMPLEMENTED_FEATURES_WARNINGS
							(dl_client_state /*<<- ("any_label_implemented; internal error; label '" +++ label_name +++ "' should be in namestable")*/)
							dl_client_state;
					// for the time being do as if the label were implemented
					= (/*True*/ False,unimplemented_labels,newly_marked_bool,dl_client_state)
			
				# (file_n_symbol_n=:(file_n,symbol_n))
					= fromJust maybe_file_n_symbol_n;
				# (symbol_index,dl_client_state)
					= symbol_n_to_offset file_n symbol_n dl_client_state;

				#! (first_symbol_n,dl_client_state)
					= dl_client_state!app_linker_state.marked_offset_a.[file_n];
				#! (is_marked_label,newly_marked_bool)
					= newly_marked_bool![first_symbol_n+symbol_n];
				| is_marked_label
					= (True,unimplemented_labels,newly_marked_bool,dl_client_state);
					
					= (any_label_implemented,[(label_name,file_n_symbol_n):unimplemented_labels],newly_marked_bool,dl_client_state);
		} // loop_on_type_def
	}
};