implementation module Request;

import StdEnv;
import ProcessSerialNumber;
import pdRequest;
import link_library_instance;
import pdObjectToMem;
import shared_buffer;
import NamesTable;
import Directory;
import CollectTypes;
import utilities;
from StrictnessList import ::StrictnessList(..);
import ExtFile;
import ExtString;
import ExtInt;
import StdDynamicLowLevelInterface;
import DefaultElem;
import cg_name_mangling;
import directory_structure;
import State;
import StdDynamicTypes;
import ToAndFromGraph;
import LibraryInstance;
import EnDecode;
import DynID;
import pdExtInt;
import typetable;
import dus_label;
import ExtArray;
import type_io_read;
import RWSDebugChoice;
import StdMaybe;
import LinkerMessages;

// platform independent
Quit :: !ProcessSerialNumber [String] !*DLServerState !*f -> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileSystem f;
Quit client_id _ s io
	#! dl_client_state
		= { default_elemU &
			id					= client_id
		,	app_linker_state	= EmptyState
		};
	= (True,client_id,AddToDLServerState dl_client_state s,io);

DUMP_DYNAMIC_LOG_NAME	:== "dumpDynamic";

AddAndInit_ :: !ProcessSerialNumber [String] !*DLServerState !*f -> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileSystem f;
AddAndInit_ client_id [eagerly_linked_client_name:_] s=:{application_path} io
	// fill application linker state by reading the complement
	#! state = EmptyState;
	#! (name_without_extension,_)
		= ExtractPathFileAndExtension eagerly_linked_client_name;

	// windows specific
	#! state = sel_platform (RemoveStaticClientLibrary state) state;
		
	#! (dl_client_state,s,io)
		= InitDLClientState default_elemU client_id name_without_extension False state s io;
	#! (ok,dl_client_state)
		= IsErrorOccured dl_client_state;

	#! dl_client_state
		= output_message_begin "AddAndInit_" client_id dl_client_state

	/*
	// log file ...		
	#! (log_file,s,io)
		= create_log_file DUMP_DYNAMIC_LOG_NAME client_id s io
	# dl_client_state 
		= { dl_client_state &
			app_linker_state.log_file = stderr
		};
	// ... log file
	*/

	#! s = AddToDLServerState dl_client_state s;
	= (not ok,client_id,s,io);
where {
	InitDLClientState dl_client_state client_id name_without_extension project_required state s=:{application_path/*,targets*/} io
		#! dl_client_state = { dl_client_state & id = client_id};
		= (dl_client_state,s,io);
};

AddAndInit_ client_id l=:[e1,e2,e3] s=:{application_path} io
	= AddAndInit_ client_id [e2,e3] s io;
	
Close :: !ProcessSerialNumber [String] !*DLServerState !*f -> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileSystem f;
Close client_id _ s=:{application_path} io
	#! (client_exists,dl_client_state,s)
		= RemoveFromDLServerState client_id s;
	| not client_exists
		= internal_error "Close (internal error): client not registered" client_id dl_client_state s io;

	#! dl_client_state = output_message_begin "Close application" client_id dl_client_state
		
	// platform dependent
	#! dl_client_state = CloseClient dl_client_state;

//	#! (dl_client_state,s,io)
//		= close_log_file client_id dl_client_state s io;
	= (True,client_id,AddToDLServerState dl_client_state s,io);

// lookup addresses of some already linked in labels
GetLabelAddresses :: !ProcessSerialNumber [String] !*DLServerState !*f -> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileEnv f;
GetLabelAddresses client_id [label_names_encoded_in_msg] s io
	#! (client_exists,dl_client_state,s) 
		= RemoveFromDLServerState client_id s;
	| not client_exists
		= internal_error "GetLabelAddresses (internal error): client not registered" client_id dl_client_state s io;

	#! dl_client_state = output_message_begin "GetLabelAddresses" client_id dl_client_state

	#! symbols = ExtractArguments '\n' 0 label_names_encoded_in_msg [];

	#! (Just main_library_instance_i,dl_client_state)
		= dl_client_state!cs_main_library_instance_i;

	#! (labels_to_be_linked,_)
		= mapSt (convert_symbol_name_into_dus_label main_library_instance_i) symbols 0;		

	#! (_,symbol_addresses,dl_client_state,io)
		= load_code_library_instance (Just labels_to_be_linked) main_library_instance_i dl_client_state io;

	// check for errors		
	#! (ok,dl_client_state) = IsErrorOccured dl_client_state;
	| not ok
		= (not ok,client_id,AddToDLServerState dl_client_state s,io);
	
	// verbose
	# messages = foldl2 produce_verbose_output2 [] labels_to_be_linked symbol_addresses;
	#! dl_client_state = DEBUG_INFO (SetLinkerMessages messages dl_client_state) dl_client_state;
	// end

	#! io = SendAddressToClient client_id symbol_addresses io;		
	= (not ok,client_id,AddToDLServerState dl_client_state s,io);
where {
	convert_symbol_name_into_dus_label library_instance_i label_name ith_address
		#! dus_label
			= { default_elem &
				dusl_label_name				= label_name
			,	dusl_library_instance_i		= library_instance_i
			,	dusl_linked					= False
			,	dusl_label_kind				= DSL_EMPTY
			,	dusl_ith_address			= ith_address
			,	dusl_address				= -1
			};
		= (dus_label,inc ith_address);
}

MessageFromSecondOrLaterLinker_ :: .(ProcessSerialNumber -> .(*DLServerState -> .(*a -> *(*DLServerState,*a)))) .b ![{#.Char}] !*DLServerState *a -> *(.Bool,ProcessSerialNumber,*DLServerState,*a) | FileSystem a;
MessageFromSecondOrLaterLinker_ open_client client_id l=:[cmd_line] s=:{application_path} io
	#! cmd_line
		= cmd_line % (1,dec (size cmd_line) - 2);
	#! x = ParseCommandLine cmd_line;
	= AddClient3 open_client client_id [s \\ s <-: x] s io;

DumpDynamic :: !ProcessSerialNumber [String] !*DLServerState !*f -> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileSystem f;
DumpDynamic client_id [cmd_line] s=:{application_path} io
	#! (client_exists,dl_client_state,s) 
		= RemoveFromDLServerState client_id s;
	| not client_exists
		= abort "DumpDynamic: client doesnot exist";
		
	# dl_client_state = AddDebugMessage "DumpDynamic" dl_client_state;

	#! dl_client_state		
		= { dl_client_state &
			do_dump_dynamic	= True
		,	cs_dlink_dir 	= application_path

		};

	# io = SendAddressToClient client_id (FILE_IDENTIFICATION application_path "") io;

	# s = AddToDLServerState dl_client_state s;
	= (False,client_id,s,io);
	
GetDynamicLinkerDir :: !ProcessSerialNumber [String] !*DLServerState !*f-> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileSystem f;
GetDynamicLinkerDir client_id [cmd_line] s=:{application_path} io
	#! (client_exists,dl_client_state,s)
		= RemoveFromDLServerState client_id s;
	| not client_exists
		= abort "DumpDynamic: client doesnot exist";
	#! dl_client_state = output_message_begin "GetDynamicLinkerDir" client_id dl_client_state
	# io = SendAddressToClient client_id application_path io;
	# s = AddToDLServerState dl_client_state s;
	= (False,client_id,s,io);
	
make_dynamic_linker_subdir :: !String !String -> String;	
make_dynamic_linker_subdir sub_dir dynamic_linker_dir 
	| IS_NORMAL_FILE_IDENTIFICATION
		= abort "make_dynamic_linker_dir; internal error; should only be called in md5-mode";
	= dynamic_linker_dir +++ "\\" +++ sub_dir;

make_dynamic_linker_library_path :: !String !String -> String;	
make_dynamic_linker_library_path dynamic_linker_dir library
	| IS_NORMAL_FILE_IDENTIFICATION
		= library;
	#! library_subdir = make_dynamic_linker_subdir DS_LIBRARIES_DIR dynamic_linker_dir;
	= library_subdir +++ "\\" +++ library;

/*
// commandline should look as follows:
//  libpath commandlineargs
// libpath should be an absolute, full path name to an existing .lib file.
// the commandlineargs are as is passed to the process
create_log_file name client_id s io
	// log-file ...
	#! (dynamic_linker_dir,s)
		= s!application_path; 
	# (_,io)
		= ds_create_directory DS_LOGS_DIR dynamic_linker_dir io;
	#! logs_subdir
		= make_dynamic_linker_subdir DS_LOGS_DIR dynamic_linker_dir;
	
	#! log_name
		= logs_subdir +++ "\\" +++ (snd (ExtractPathAndFile name)) +++ "_" +++ (toString (GetOSProcessSerialNumber client_id));
	#! (_,log_file,io)
		= fopen (log_name +++ ".log") FWriteText io;	
	// ... log-file
	= (log_file,s,io);

close_log_file :: !ProcessSerialNumber !*DLClientState !*DLServerState !*f -> (!*DLClientState,!*DLServerState,!*f) | FileSystem f;
close_log_file client_id dl_client_state=:{do_dump_dynamic} s io
	#! (log_file,dl_client_state)
		= extract_log_file dl_client_state;
		with {
			extract_log_file dl_client_state=:{app_linker_state={log_file}}
				= (log_file,{dl_client_state & app_linker_state.log_file = stderr});
		};
	#! (_,io)
		= fclose log_file io;
	| not do_dump_dynamic
		= (dl_client_state,s,io);	
		
	// delete dumpDynamic log-file
	#! (dynamic_linker_dir,s)
		= s!application_path; 
	#! name
		= DUMP_DYNAMIC_LOG_NAME;
	#! logs_subdir
		= make_dynamic_linker_subdir DS_LOGS_DIR dynamic_linker_dir;
	#! log_name
		= logs_subdir +++ "\\" +++ (snd (ExtractPathAndFile name)) +++ "_" +++ (toString (GetOSProcessSerialNumber client_id));
		
	#! ((_,p),io)
		= pd_StringToPath (log_name +++ ".log") io;
	#! (_,io)
		= fremove p io;
	= (dl_client_state,s,io);
*/	
encode_command_line :: ![String] -> {#Char};
encode_command_line cmd_line
	= foldSt quote_if_necessary cmd_line {};
	with {
		quote_if_necessary arg s 
			| arg_contains_spaces 0 (size arg)
				= s +++ " \"" +++ arg +++ "\"";
			
				= s +++ " " +++ arg;
		where {
			arg_contains_spaces i s_a
				| i == s_a
					= False;
				| isSpace arg.[i] 
					= True;
					= arg_contains_spaces (inc i) s_a;
		}
	}

AddClient3 :: .(ProcessSerialNumber -> .(*DLServerState -> .(*a -> *(*DLServerState,*a)))) .b ![{#.Char}] !*DLServerState *a -> *(.Bool,ProcessSerialNumber,*DLServerState,*a) | FileSystem a;
AddClient3 open_client client_id [_:xl] s=:{application_path} io
	// initialize dl_client_state
	# dl_client_state
		= { default_elemU &
			app_linker_state	= EmptyState
		};
		
	# (batch_path, xl)
		=	parse_batch_path xl;
		with {
			parse_batch_path :: [{#Char}] -> ({#Char},[{#Char}]);
			parse_batch_path ["--client-batch-file",batch_path:args]
				=	(batch_path, args);
			parse_batch_path args
				=	("", args);
		};

	# parsed_cmd_line
		= h { arg \\ arg <- xl };

	# parsed_cmd_line
		= case (FILE_IDENTIFICATION True False) of {
			True
				#! (x,parsed_cmd_line)
					= parsed_cmd_line![0];
				# p
					= make_dynamic_linker_library_path application_path x;
				-> {parsed_cmd_line & [0] = p};
			_
				-> parsed_cmd_line;
		};

	// console or gui application
	# (path_file,n)
		= ExtractPathFileAndExtension parsed_cmd_line.[0];
	# open_console_window
		= if IS_NORMAL_FILE_IDENTIFICATION (path_file.[dec (size path_file)] == 'c') True;
		
	# ((ok,path),io)
		= pd_StringToPath parsed_cmd_line.[0] io;
	# ((error,_),io)
		= getFileInfo path io;
		
	#! (current_directory,file_name)
		=  if (batch_path=="")
			(ExtractPathAndFile parsed_cmd_line.[0])
			(fst (ExtractPathAndFile batch_path), batch_path);

	#! new_cmd_line
		= encode_command_line (tl xl)

	#! (client_started,client_id,client_executable,s)
		= StartClientApplication3 current_directory file_name open_console_window new_cmd_line s;
	#! dl_client_state
		= { dl_client_state & id = client_id };
	| not client_started
		#! msg
			= "file '" +++ client_executable +++ "' cannot be started";
		= (True,client_id,AddToDLServerState (AddMessage (LinkerError msg) dl_client_state) s,io);

		#! name
			= fst (ExtractPathFileAndExtension parsed_cmd_line.[0]);
			
//		#! (log_file,s,io)
//			= create_log_file name client_id s io
				
		# dl_client_state 
			= { dl_client_state &
				cs_main_library_name = name
			,	cs_dlink_dir 	= application_path
//			,	app_linker_state.log_file = log_file
			};
					
		# title
			= "AddClient3"
		#! dl_client_state
			= output_message_begin title client_id dl_client_state;

		#! s
			= AddToDLServerState dl_client_state s;
		#! (s,io)
			= open_client client_id s io
		= (False,client_id,s,io);
where {
 	h :: !*{#{#Char}} -> *{#{#Char}};
 	h i = i;

	build_cmdline_in_addclient_format i limit cmd_line
		| i == limit
			= "";
			= cmd_line.[i] +++ (if (i == (dec limit)) "" " ") +++ (build_cmdline_in_addclient_format (inc i) limit cmd_line);
};
	
// Loads an application from a library
// 
// Output:
// - for each set of type equivalence with at least two types, a single implementation has been linked in.
LoadApplication :: !ProcessSerialNumber [String] !*DLServerState !*f -> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileEnv, FileSystem f;
LoadApplication client_id _ s io
	// copy from Init
	#! (client_exists,dl_client_state,s)
		= RemoveFromDLServerState client_id s;
	| not client_exists
		= internal_error "LoadApplication (internal error): client not registered" client_id dl_client_state s io;
		
	# (main_code_type_lib,dl_client_state)
		= dl_client_state!cs_main_library_name;

	#! title = "LoadApplication: " +++ snd (ExtractPathAndFile main_code_type_lib)
	#! dl_client_state = output_message_begin title client_id dl_client_state

	#! args = [];

	// check args-argument of Init-request
	#! dl_client_state
		= case (sel_platform True False) of {
			True
				// winOS
				| not (isEmpty args) 
					#! dl_client_state
						= AddMessage (LinkerError "args argument of Init in Request.icl cannot have arguments") dl_client_state;
					-> dl_client_state;
					-> dl_client_state;
			False
				// macOS
				/*
				| length args <> 1 //isEmpty args
					#! dl_client_state
						= AddMessage (LinkerError "args argument of Init in Request.icl should have exactly one parameter") dl_client_state;
					-> dl_client_state;
					
					#! dl_client_state
						= app_pd_state (\pd_state -> {pd_state & qd_address = FromStringToInt (hd args) 0}) dl_client_state;
					-> dl_client_state;
				*/
 				-> abort "LoadApplication; Init (line 131) uncomment!!!";
		}
		
	#! (dlink_dir,s)
		= GetDynamicLinkerDirectory s;
	#! (to_and_from_graph_table,io)
		= init_to_and_from_graph_table dlink_dir io;

	#! (library_instance_i,_,dl_client_state=:{cs_main_library_instance_i},io)
		= RegisterLibrary Nothing main_code_type_lib dl_client_state io;
	# dl_client_state = { dl_client_state & cs_to_and_from_graph	= to_and_from_graph_table };
	#! dl_server_state = s;
	#! (start_addr,_,dl_client_state,io)
		= load_code_library_instance Nothing library_instance_i dl_client_state io; 
 	# io = SendAddressToClient client_id (FromIntToString start_addr) io;

	# dl_client_state = AddDebugMessage ("###start:" +++ (hex_int start_addr)) dl_client_state;
		
	// check for errors
	#! (ok,dl_client_state)
		= IsErrorOccured {dl_client_state & initial_link = False};
	= (not ok,client_id,AddToDLServerState dl_client_state dl_server_state,/*KillClient3 client_id ok*/ io);

AddAndInitPC_ :: ProcessSerialNumber ![{#.Char}] *DLServerState *a -> *({#{#Char}},*(!Bool,!ProcessSerialNumber,!*DLServerState,!*a)) | FileSystem a;
AddAndInitPC_ client_id [commandline] s io
	// extract executable name
	#! parsed_command_line
		= ParseCommandLine commandline;
	= (parsed_command_line,AddAndInit_ client_id [ p \\ p <-: parsed_command_line ] s io);
AddAndInitPC_ client_id q=:[commandline,do_add_project] s io
	#! parsed_command_line
		= ParseCommandLine commandline;
		= (parsed_command_line,AddAndInit_ client_id ([ p \\ p <-: parsed_command_line ] ++ [do_add_project]) s io);
AddAndInitPC_ _ l s io
	= abort ("AddAndInitPC" +++ toString (length l));
	
// should use normalized constructors
// 1. constructors with smallest arity
// 2. alpabetically ordered
tio_type_ref_to_address tio_type_ref=:{tio_tr_module_n,tio_tr_type_def_n,tio_type_without_definition=Nothing} type_table_i library_instance_i dl_client_state
	// get string table
    #! (string_table,dl_client_state)
        = dl_client_state!cs_type_tables.[type_table_i].tt_type_io_state.tis_string_table;

	// get type name
    #! ({tio_td_name,tio_td_arity,tio_td_args,tio_td_rhs},dl_client_state)
        = dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_type_defs.[tio_tr_type_def_n];
	# type_name
		= get_name_from_string_table tio_td_name string_table;

    // get module name
    #! (tio_module,dl_client_state)
        = dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_module;
	# module_name
		= get_name_from_string_table tio_module string_table;

	// TC; prefix moet geimporteerd worden van de compiler
	
	// find constructor name of a TC;-type
	// Example :: TC;List a = TC;List (List a)	
	#! (maybe_tio_type_ref,dl_client_state)
		= findTypeUsingTypeName ("TC;" +++ type_name) module_name type_table_i dl_client_state;
	| isNothing maybe_tio_type_ref
		= abort ("GetTypeInfo; internal error; type '" +++ type_name +++ "' not found.");
		
	#! tio_type_ref
		= fromJust maybe_tio_type_ref;
	| isJust tio_type_ref.tio_type_without_definition
		= abort ("GetTypeInfo; internal error; predefined types are not allowed");
		
	#! (_,_,label_names,dl_client_state)
		= get_type_label_names tio_type_ref type_table_i dl_client_state;
	| length label_names <> 1
		= abort ("GetTypeInfo; internal error; There should be only one TC;Type-constructor for each type");
	
	// convert constructor name to (file_n,symbol_n)	
	#! constructor_label_name
		= hd label_names;
	# (maybe_constructor_file_n_and_symbol_n,dl_client_state)
		= findLabel constructor_label_name library_instance_i dl_client_state;
	| isNothing maybe_constructor_file_n_and_symbol_n
		= abort ("GetTypeInfo; internal error; Cannot convert " +++ constructor_label_name +++ " to (file_n,symbol_n)");
	
	# (file_n,symbol_n)
		= fromJust maybe_constructor_file_n_and_symbol_n
		
	// get address of constructor name
	# (maybe_constructor_address,dl_client_state)
		=isLabelImplemented file_n symbol_n dl_client_state;
	| isNothing maybe_constructor_address
		= abort ("GetTypeInfo; internal error; Constructor label " +++ constructor_label_name +++ " should have been implemented");
		
	# constructor_label_address
		= (fromJust maybe_constructor_address) bitor 2;
		
	= (constructor_label_address,dl_client_state);	
	
lookup_type_id (LIT_TypeReference _ {tio_type_without_definition=Just type_name}) _
	# maybe_index  = findAi (\i (type_name2,_) -> if (type_name == type_name2) (Just i) Nothing) INDEX_TO_PREDEFINED_TYPE_STRING;
	| isNothing maybe_index
		=  abort ("lookup_type_id; internal error; cannot find index for *predefined* type '" +++ type_name +++ "'");
		= fromJust maybe_index;

lookup_type_id type1 type_ids
	# x = filter (\(type_id,type2) -> type1 == type2) type_ids	
	| length x <> 1
		= abort "lookup_type_id; internal error; type has not been assigned an id";
		
	# type_id
		= fst (hd x)
	= type_id;

GetTypeInfo :: !ProcessSerialNumber [String] !*DLServerState !*f -> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileSystem, FileEnv f;
GetTypeInfo client_id [arg] s io
	#! (client_exists,dl_client_state,s) 
		= RemoveFromDLServerState client_id s;
	| not client_exists
		= internal_error "GetTypeInfo (internal error): client not registered" client_id dl_client_state s io;

	#! dl_client_state
		= output_message_begin "GetTypeInfo" client_id dl_client_state;
		
	// decode arg block
	#! descPs
		= help (decode arg);
		with {
			help :: !{#Int} -> {#Int};
			help i = i
		}
	| size descPs == 0
		= abort "GetTypeInfo; no type definitions requested";

	// descriptor address 		
	#! maybe_closure
		= findAi foo descPs 
		with {
			foo :: !Int !Int -> (Maybe Int);
			foo _ descP
				| descP bitand 2 == 0
					= abort "closure"
					= Nothing
		}
	| isJust maybe_closure
		= abort "GetTypeInfo; encountered closure";
		
	// sort types (associated with addresses)
	#! (n_library_instances,dl_client_state)
		= dl_client_state!cs_library_instances.lis_n_library_instances;
	#! set_of_descPs_and_root_types
		= help_type_checker (createArray n_library_instances ([],[]));
		with {
			help_type_checker :: !*{([Int],[TypeTableTypeReference])} -> *{([Int],[TypeTableTypeReference])};
			help_type_checker k
				= k;
		}
	#! (set_of_descPs_and_root_types,dl_client_state)
		= foldSt determine_type_from_descP [ descP \\ descP <-: descPs ] (set_of_descPs_and_root_types,dl_client_state);
		with {
			determine_type_from_descP descP (set_of_descPs_and_root_types,dl_client_state)
				# (library_instance_i,(maybe_type,dl_client_state)) = find_type_using_its_constructors (descP bitand 0xfffffffc) dl_client_state;
				| isNothing maybe_type
					= abort "determine_type_from_descP: internal error; could not associate a type with specified constructor address";
	
				# ((descPs,root_types),set_of_descPs_and_root_types)
					= set_of_descPs_and_root_types![library_instance_i];
				#! set_of_descPs_and_root_types
					= { set_of_descPs_and_root_types & 
						[library_instance_i] = ([descP:descPs],[fromJust maybe_type:root_types])
					};
				= (set_of_descPs_and_root_types,dl_client_state);
		}
		
	#! (n_type_definitions,(id_adresses_of_root_types,type_defs),dl_client_state)
		= mapAiSt collect_type_definitions set_of_descPs_and_root_types (N_PREDEFINED_INDICES,([],[]),dl_client_state);
		with {
			collect_type_definitions i ([],[]) s
				= s;
				
			collect_type_definitions library_instance_i (descPs,root_types) (n_type_definitions,(id_adresses_of_root_types,type_defs),dl_client_state)
				#! (id_adresses_of_root_types2,type_defs2,dl_client_state)
					= get_type_definitions_and_addresses library_instance_i descPs root_types n_type_definitions dl_client_state
				
				#! new_addresses
					= id_adresses_of_root_types2 ++ id_adresses_of_root_types;
				#! new_type_defs
					= type_defs2 ++ type_defs;
					
				= (n_type_definitions + length type_defs2,(new_addresses,new_type_defs),dl_client_state);
		}
										
	#! encoded_message
		= encode (id_adresses_of_root_types,type_defs)
	#! ok
		= True	
		
	#! messages
		= []
	#! dl_client_state
		= SetLinkerMessages messages dl_client_state ;
	
	#! io
		= SendAddressToClient client_id encoded_message io;
		
	= (not ok,client_id,AddToDLServerState dl_client_state s,io);
where {
	find_implementing_library_instance descP dl_client_state
		// which library implements the constructor?
		# (lis_n_library_instances,dl_client_state) = dl_client_state!cs_library_instances.lis_n_library_instances;
		# (maybe_library,dl_client_state)
			= findAst check_memory_areas dl_client_state lis_n_library_instances;
			with {
				check_memory_areas library_instance_i dl_client_state
					# (li_memory_areas,dl_client_state)
						= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_memory_areas;
					# found_memory_areas
						= filter is_descP_within_memory_area li_memory_areas
						with {
							is_descP_within_memory_area {ma_begin,ma_end}
								= between ma_begin descP ma_end
						}
					| isEmpty found_memory_areas
						= (Nothing,dl_client_state);
						= (Just library_instance_i,dl_client_state);
			}
		| isNothing maybe_library
			= abort ("GetTypeInfo: unknown address " +++ hex_int2 descP);
		
			= (fromJust maybe_library,dl_client_state);

	find_type_using_its_constructors descP dl_client_state 
		#! (library_instance_i,dl_client_state)
			= find_implementing_library_instance descP dl_client_state;	
				
		// find type of the constructor at address descP
		#! (x=:(maybe_type,dl_client_state))
			= findAst (foo descP library_instance_i) dl_client_state SYMBOL_TABLE_SIZE;
		= (library_instance_i,x);
	where {
		foo descP library_instance_i i dl_client_state
			#! (names_table_elements,dl_client_state)
				= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_names_table.[i];
			#! (maybe_type,dl_client_state)
				= find_in_names_table_elements names_table_elements dl_client_state;
				with {
					find_in_names_table_elements EmptyNamesTableElement dl_client_state
						= (Nothing,dl_client_state);
					find_in_names_table_elements (NamesTableElement n symbol_n file_n next) dl_client_state
						| file_n < 0
							= find_in_names_table_elements next dl_client_state;
							
						#! (maybe_address,dl_client_state)
							= isLabelImplemented file_n symbol_n dl_client_state
						| isNothing maybe_address
							= find_in_names_table_elements next dl_client_state;
					
						| fromJust maybe_address <> descP
							= find_in_names_table_elements next dl_client_state;
				
						#! maybe_substring = contains_substring "__dTC_I" n
						| isNothing maybe_substring
							= abort ("GetTypeInfo; internal error; should contain '__dTC_I' substring >" +++ n +++ "<");
							
							# (start_substring,end_substring) = fromJust maybe_substring;
							
							// extract type and its defining module name
							#! mangled_module_name
								= n % (size "e__",dec start_substring);
							#! mangled_type_name
								= n % (inc end_substring,dec (size n));
					
							# module_name
								= demangle mangled_module_name;
							# type_name 
								= demangle mangled_type_name;
								
							// convert type into internal representation
							#! (type_table_i,dl_client_state)
								= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
							#! (maybe_tio_type_ref,dl_client_state)
								= findTypeUsingTypeName type_name module_name type_table_i dl_client_state;
							| isNothing maybe_tio_type_ref
								= abort ("GetTypeInfo; internal error; type '" +++ type_name +++ "' not found.");
								
								# r = TypeTableTypeReference type_table_i (fromJust maybe_tio_type_ref)
								= (Just r,dl_client_state);
				}					
			= (maybe_type,dl_client_state);
	}

}

convert_strictness NotStrict
	= NotStrict`;
convert_strictness (Strict strictness)
	= Strict` strictness;
convert_strictness (StrictList strictness next)
	= StrictList` strictness (convert_strictness next);

convert_tio_type type_ids library_instance_i {tio_at_type=TIO_TAS tio_symb_ident tio_atypes strictness_list} dl_client_state
	# id
		= lookup_type_id (LIT_TypeReference (LibRef library_instance_i) tio_symb_ident.tio_type_name_ref) type_ids

	# (converted_tio_atypes,dl_client_state)
		= mapSt (\tio_atype dl_client_state -> convert_tio_type type_ids library_instance_i tio_atype dl_client_state) tio_atypes dl_client_state;
	= (TypeApp` id converted_tio_atypes (convert_strictness strictness_list),dl_client_state);

convert_tio_type type_ids library_instance_i {tio_at_type=TIO_TV {tio_tv_name}} dl_client_state
	= (TypeVar` tio_tv_name,dl_client_state);

convert_tio_type type_ids library_instance_i {tio_at_type=TIO_TB (TIO_BT_String _)} dl_client_state
	= (TypeApp` LAZYARRAY_INDEX [TypeApp` CHAR_INDEX [] NotStrict`] NotStrict`,dl_client_state);
convert_tio_type type_ids library_instance_i {tio_at_type=TIO_TB tio_basic_type} dl_client_state
	# tcc_index
		= case tio_basic_type of {
			TIO_BT_Int		-> INT_INDEX;
			TIO_BT_Char		-> CHAR_INDEX;
			TIO_BT_Real		-> REAL_INDEX;
			TIO_BT_Bool		-> BOOL_INDEX;
			TIO_BT_Dynamic	-> DYNAMIC_INDEX;
			TIO_BT_File		-> FILE_INDEX;
			TIO_BT_World	-> WORLD_INDEX;
		}
	= (TypeApp` tcc_index [] NotStrict`,dl_client_state);
convert_tio_type type_ids library_instance_i {tio_at_type=type1 ----> type2} dl_client_state
	# (converted_type1,dl_client_state)	= convert_tio_type type_ids library_instance_i type1 dl_client_state;
	# (converted_type2,dl_client_state)	= convert_tio_type type_ids library_instance_i type2 dl_client_state;
	= (FuncApp` converted_type1 converted_type2,dl_client_state);
	
convert_tio_type _ _  s dl_client_state
	= abort "GetTypeInfo; internal error; cannot convert TIO-type";

// gets the type definitions of root_types/descP of the *SAME* library instance
get_type_definitions_and_addresses library_instance_i descPs root_types n_type_definitions dl_client_state
	// compute dependencies
	# (type_tables,dl_client_state)
		= get_type_tables dl_client_state;
	# cts
		= {default_collect_types_state & cts_type_tables = type_tables};
		
	# ([TypeTableTypeReference type_table_i _:_])
		= root_types;
	# (cts=:{cts_type_dependencies,cts_type_tables=type_tables})
		= collect_types_loop (init_collect_types type_table_i type_table_i [ (tio_type_ref,tio_type_ref) \\ TypeTableTypeReference _ tio_type_ref <- root_types ] cts);
	# dl_client_state
		= { dl_client_state & cs_type_tables = type_tables };
	# types
		= [ c1 \\ (c1,c2) <- cts_type_dependencies | isUserDefined c1];
		with {
			isUserDefined {tio_type_without_definition=Just s}		= False;
			isUserDefined _											= True;
		}
		
	#! (tt_name,dl_client_state)
		= dl_client_state!cs_type_tables.[type_table_i].tt_name;
	#! (_,type_table_identifier)
		= ExtractPathAndFile tt_name;
					
	#! type_ids
		= [ (type_id,LIT_TypeReference (LibRef library_instance_i) type) \\ type <- types & type_id <- [n_type_definitions..] ];
	#! (id_adresses_of_root_types,dl_client_state)
		= map2St associate_id_and_address root_types descPs dl_client_state;
		with {
			associate_id_and_address :: !TypeTableTypeReference !Int !*DLClientState -> ((!Int,!Int),!*DLClientState);
			associate_id_and_address root_type=:(TypeTableTypeReference _ tio_type_ref1) descP dl_client_state
				# x = filter (\(_,LIT_TypeReference _ tio_type_ref2) -> equal_tio_types tio_type_ref1 tio_type_ref2) type_ids;
					with {
						equal_tio_types tr1=:{tio_type_without_definition=Nothing} tr2=:{tio_type_without_definition=Nothing}
							= tr1.tio_tr_module_n == tr2.tio_tr_module_n && tr1.tio_tr_type_def_n == tr2.tio_tr_type_def_n;
						equal_tio_types {tio_type_without_definition=Just s} _
							= abort ("equal_tio_types; internal error; predefined types cannot be processed " +++ s);
						equal_tio_types _ {tio_type_without_definition=Just s}
							= abort ("equal_tio_types; internal error; predefined types cannot be processed " +++ s);
					}
				| length x <> 1
					= abort "associate_id_and_address; internal error; root type has not been assigned an id";
					
				# type_id
					= fst (hd x)
				= ((descP,type_id),dl_client_state);
		};
	
	// ? TIO_TypeReference
    #! (string_table,dl_client_state)
        = dl_client_state!cs_type_tables.[type_table_i].tt_type_io_state.tis_string_table;

	#! (l,dl_client_state)
		= mapSt (convert_type type_ids) types dl_client_state;
		with {
			convert_type type_ids tio_type_ref=:{tio_tr_module_n,tio_tr_type_def_n} dl_client_state
				# (type_def,dl_client_state)
					= deref tio_type_ref dl_client_state;
					
				// enter type
				#! type_id
					= lookup_type_id (LIT_TypeReference (LibRef library_instance_i) tio_type_ref) type_ids
					
				// get type name
			    #! ({tio_td_name,tio_td_arity,tio_td_args,tio_td_rhs},dl_client_state)
			        = dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_type_defs.[tio_tr_type_def_n];

				# type_name
					= get_name_from_string_table tio_td_name string_table;
				# (type_rhs,dl_client_state)
					= case tio_td_rhs of {
						TIO_AlgType constructors
							#! (mapped_constructors,dl_client_state)
								= mapSt convert_constructor constructors dl_client_state
								with {
									convert_constructor constructor=:{tio_ds_ident,tio_ds_arity,tio_ds_index} dl_client_state
										#! constructor_name
											= get_name_from_string_table tio_ds_ident string_table;
											
										#! (tio_cons_type=:{tio_st_args,tio_st_args_strictness},dl_client_state)
											= dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_cons_defs.[tio_ds_index].tio_cons_type;

										// :: Tree a = Node a (Tree a) (Tree a) | Leaf
										// Leaf :: (Tree a)
										// Node :: a (Tree a) (Tree a) -> (Tree a)										
										#! (arg_types,dl_client_state)
											= mapSt (convert_tio_type type_ids library_instance_i) tio_st_args dl_client_state;
											
										// find constructor addresses
										#! (constructor_labels,dl_client_state)
											= generate_algebraic_type_label_names tio_type_ref type_table_i string_table constructor ([],dl_client_state);
										#! (addresses,dl_client_state)
											= convert_constructor_labels_to_addresses constructor_labels dl_client_state;
										= (Constructor` constructor_name arg_types (convert_strictness tio_st_args_strictness) addresses,dl_client_state);
								}							
							-> (AlgType` mapped_constructors,dl_client_state);
						TIO_RecordType tio_record_type=:{tio_rt_constructor={tio_ds_arity,tio_ds_index},tio_rt_fields}
							#! (tio_st_args_strictness,dl_client_state)
								= dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_cons_defs.[tio_ds_index].tio_cons_type.tio_st_args_strictness;

							#! (fields,dl_client_state)
								= mapSt convert_record_field [ field \\ field <-: tio_rt_fields ] dl_client_state;
								with {
									convert_record_field {tio_fs_name,tio_fs_index} dl_client_state
										# field_name = get_name_from_string_table tio_fs_name string_table;
										#! ({tio_st_result},dl_client_state)
											= dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_selector_defs.[tio_fs_index].tio_sd_type;
										#! (type,dl_client_state)
											= convert_tio_type type_ids library_instance_i tio_st_result dl_client_state;
										= (Field` field_name type,dl_client_state);
								}

							#! (record_label_names,dl_client_state)
								= generate_record_label tio_type_ref type_table_i string_table type_name tio_record_type dl_client_state;
							#! (addresses,dl_client_state)
								= convert_constructor_labels_to_addresses record_label_names dl_client_state;
			
							-> (RecordType` fields (convert_strictness tio_st_args_strictness) addresses,dl_client_state);
						_
							-> abort "GetTypeInfo; only algebraic, record and predefined types are supported.";							
					};
				with {
					convert_constructor_labels_to_addresses constructor_labels dl_client_state
						= foldSt constructor_label_to_address constructor_labels ([],dl_client_state);
					where {
						constructor_label_to_address constructor_label (addresses,dl_client_state)
							#! (maybe_file_n_symbol_n,dl_client_state)
								= findLabel constructor_label library_instance_i dl_client_state;
							| isNothing maybe_file_n_symbol_n
								= abort ("constructor_label_to_address; internal error; could not find '" +++ constructor_label +++ "'");
								
							#! (file_n,symbol_n)
								= fromJust maybe_file_n_symbol_n;
							#! (maybe_address,dl_client_state)
								= isLabelImplemented file_n symbol_n dl_client_state;
							| isNothing maybe_address
								// label need not be implemented but dynamic type may reference its defining type
								= (addresses,dl_client_state);
							
								= ([fromJust maybe_address:addresses],dl_client_state);
					}
				}
				
				# type_def
					= { 
						td_id	= type_id
					,	td_uid 	= { uti_id = type_table_identifier, uti_type_ref = tio_type_ref}
					,	name	= type_name
					,	arity	= tio_td_arity
					,   args 	= [ tio_atv_variable.tio_tv_name \\ {tio_atv_variable} <- tio_td_args ]
					,	rhs		= type_rhs
					};
				= (type_def,dl_client_state);
			where {
				deref {tio_type_without_definition=Nothing,tio_tr_module_n,tio_tr_type_def_n} dl_client_state
					= dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_type_defs.[tio_tr_type_def_n];
				deref {tio_type_without_definition=Just type_name} dl_client_state
					= abort ("GetTypeInfo; internal error; undefined for basic types (" +++ type_name +++ ")");
			}
		}
	= (id_adresses_of_root_types,l,dl_client_state);

UniversalTypeID_to_TypeCodeConstructor_address :: !ProcessSerialNumber [String] !*DLServerState !*f -> (!Bool,!ProcessSerialNumber,!*DLServerState, !*f) | FileSystem, FileEnv f;
UniversalTypeID_to_TypeCodeConstructor_address client_id [arg] s io
	#! (client_exists,dl_client_state,s) 
		= RemoveFromDLServerState client_id s;
	| not client_exists
		= internal_error "UniversalTypeID_to_TypeCodeConstructor_address (internal error): client not registered" client_id dl_client_state s io;

	#! dl_client_state
		= output_message_begin "UniversalTypeID_to_TypeCodeConstructor_address" client_id dl_client_state;
		
	// body ...
	#! utids
		= help (decode arg);
		with {
			help :: [UniversalTypeID] -> [UniversalTypeID];
			help i = i
		};
		
	#! (type_code_constructor_addresses,(dl_client_state,io))
		= mapSt convert_to_address utids (dl_client_state,io);
		with {
			convert_to_address {uti_type_ref={tio_type_without_definition=Just _}} (dl_client_state=:{cs_library_instances={lis_n_library_instances}},io)
				= abort "convert_to_address; internal error; cannot yet converted predefined types";
			convert_to_address uti=:{uti_id,uti_type_ref} (dl_client_state=:{cs_library_instances={lis_n_library_instances}},io)
				// find library instance
				#! (maybe_library_instance_i,dl_client_state)
					= findAst (find_library_id uti_id) dl_client_state lis_n_library_instances;
				| isNothing maybe_library_instance_i
					= abort "convert_to_address; library in universal type cannot be found";
					
				// convert to TC;<type> using LIT_TypeReference
				#! library_instance_i
					= fromJust maybe_library_instance_i;
					
				#! (type_table_i,dl_client_state)
					= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
					
				#! tc_type
					= { uti_type_ref & tio_tr_type_def_n = inc uti_type_ref.tio_tr_type_def_n };
				#! tc_library_type
					= LIT_TypeReference (LibRef library_instance_i) tc_type;
					
					
				#! (type_name,module_name,dl_client_state)
					= get_names tc_type type_table_i dl_client_state;
					
				// determine whether TC;<type> has been implemented
				#! (maybe_tc_type_name_and_labels,dl_client_state)
					= isTypeImplemented tc_library_type dl_client_state;
				| isNothing maybe_tc_type_name_and_labels
					// TC;<type>
					// If TC;<type> is implemented, then <type> is also implemented. The reverse is not
					// true.
					#! (type_name,module_name,label_names,dl_client_state)
						= get_type_label_names tc_type type_table_i dl_client_state;
					| False <<- (type_name,label_names)
						= undef;
						
					#! label_names
						= [ 
							{ default_elem & 
								dusl_label_name 		= label_name
							,	dusl_library_instance_i	= library_instance_i
							,	dusl_linked				= False
							} \\ label_name <- label_names ]

					#! (_,_,dl_client_state/*,s*/,io)
						= load_code_library_instance (Just label_names) library_instance_i dl_client_state /*s*/ io;
					= convert_to_address uti (dl_client_state,io);
					
				#! (type_name,labels)
					= fromJust maybe_tc_type_name_and_labels;
				| length labels <> 1
					// consistency check
					= abort "convert_to_address; internal error; TC;<type> is implemented by one label only";
					
				// find the address of the sole constructor implementing TC;<type>
				#! label_name
					= hd labels;
				#! (maybe_file_n_and_symbol_n,dl_client_state)
					= findLabel label_name library_instance_i dl_client_state;
				| isNothing maybe_file_n_and_symbol_n
					= abort ("convert_to_address; internal error; constructor label for " +++ type_name +++ " does not exist");
					
				#! (file_n,symbol_n)
					= fromJust maybe_file_n_and_symbol_n;
				#! (maybe_address,dl_client_state)
					= isLabelImplemented file_n symbol_n dl_client_state;
				| isNothing maybe_address
					= abort "convert_to_address; internal error; cannot get address of constructor label for TC;<type>";
					
				= (fromJust maybe_address,(dl_client_state,io));
			where {
				find_library_id required_library_id library_instance_i dl_client_state
					| library_instance_i < RTID_LIBRARY_INSTANCE_ID_START 
						= (Nothing,dl_client_state)
	
					#! (library_id,dl_client_state)
						= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_id;
					| library_id == required_library_id
						= (Just library_instance_i,dl_client_state);
						= (Nothing,dl_client_state)
			};		
		}
	// ... body

	// return						
	#! encoded_message
		= encode (help type_code_constructor_addresses)
		with {
			help :: [Int] -> [Int];
			help i = i;
		};
	#! ok
		= True	
		
	#! messages
		= []
	#! dl_client_state
		= SetLinkerMessages messages dl_client_state ;
	
	#! io
		= SendAddressToClient client_id encoded_message io;
		
	= (not ok,client_id,AddToDLServerState dl_client_state s,io);