implementation module DLState;

from containers import arg_is_strict;
EXTEND_TYPE_INFO yes no :== no;

// StdEnv
import StdEnv;
import LibraryState;
// Linker
import State;
//import ReadLibrary;
import ProcessSerialNumber;
//import DebugUtilities;
F a b :== b;

// Ext
import ExtList;

import StdEnv, deltaEventIO, deltaMenu, deltaWindow, deltaTimer, deltaDialog;

import ClientWindow;
import DynamicLink;

import Directory;
/*2.0
from deltaIOState import class FileEnv, instance  FileEnv (IOState s) ;
0.2*/
//1.3
from deltaIOState import FileEnv;
//3.1

import ExtInt;

import dynamics; // internal constants for dynamics

import DynamicID;
import StdDynamicLowLevelInterface;
import typetable;
import MemoryState;
import LibraryInstance;
import type_io_equal_types;
import TypeImplementationTable;
import ToAndFromGraph;
import ToAndFromGraph;


:: *DLServerState
	= {
	// general data
		quit_server						:: !Bool
	,	application_path				:: !String
	,	static_application_as_client	:: !Bool
	
	// clients
	,	dl_client_states				:: *[*DLClientState]
	
	// client windows
	,	global_client_window			:: !GlobalClientWindow
	
	// conversions
	,	convert_functions				:: !ConvertFunctions
	
	// NEW TO HANDLE .LIB DEMANDS
	,	dlss_lib_mode					:: !Bool
	,	dlss_lib_command_line			:: !{{#Char}}
	};
	
DefaultDLServerState :: !*DLServerState;
DefaultDLServerState 
	= {
	// general data
		quit_server						= False
	,	application_path				= ""
	,	static_application_as_client	= False
	
	// clients
	,	dl_client_states				= []
	
	// client windows
	,	global_client_window			= DefaultGlobalClientWindow
	
	// conversions
	,	convert_functions				= default_convertfunctions

	// NEW TO HANDLE .LIB DEMANDS
	,	dlss_lib_mode					= False
	,	dlss_lib_command_line			= {}
	};	

AddToDLServerState :: *DLClientState *DLServerState -> *DLServerState; 	
AddToDLServerState dl_client_state dl_server_state=:{dl_client_states}
	#! dl_server_state 
		= { dl_server_state &
			dl_client_states = [dl_client_state:dl_client_states]
		};
	= dl_server_state;

RemoveFromDLServerState :: !ProcessSerialNumber !*DLServerState -> (!Bool,!*DLClientState,!*DLServerState);
RemoveFromDLServerState client_id dl_server_state=:{dl_client_states}
	#! (l,r)
		= splitAtPred f dl_client_states [] [];
	#! (l_empty,l)
		=  is_empty l;
	| not l_empty
		#! dl_server_state
			= { dl_server_state &
				dl_client_states	= r
			};
		= (True,hd l,dl_server_state);
		
		= (False,DefaultDLClientState,{dl_server_state & dl_client_states = r});
where {
	f dl_client_state=:{id}
		= (id == client_id,dl_client_state);
};	
	
acc_dl_client_states :: ([*DLClientState] -> (.x,[*DLClientState])) !*DLServerState -> (.x,!*DLServerState);
acc_dl_client_states f dl_server_state=:{dl_client_states}
	#! (x,dl_client_states)
		= f dl_client_states;
	= (x, {dl_server_state & dl_client_states = dl_client_states} );
	
app_dl_client_states :: ([*DLClientState] -> [*DLClientState]) !*DLServerState -> !*DLServerState;
app_dl_client_states f dl_server_state=:{dl_client_states}
	= {dl_server_state & dl_client_states = f dl_client_states};

selacc_client_state :: !ProcessSerialNumber (*DLClientState -> (.x,*DLClientState)) !*DLServerState -> (.x,!*DLServerState);
selacc_client_state client_id g dl_server_state=:{dl_client_states}
	#! (l,r)
		= splitAtPred f dl_client_states [] [];
	#! (l_empty,l)
		=  is_empty l;
	| not l_empty
		#! (x,l)
			= g (hd l);
		#! dl_server_state 
			= { dl_server_state &
				dl_client_states = [l:r]
			};
		= (x,dl_server_state);
where {
	f dl_client_state=:{id}
		= (id == client_id,dl_client_state);
};

selacc_app_linker_state :: !ProcessSerialNumber !(*State -> *(.a,*State)) !*DLServerState -> *(.a,*DLServerState);
selacc_app_linker_state client_id f dl_server_state
	#! (x,dl_server_state)
		= selacc_client_state client_id w dl_server_state;
	= (x,dl_server_state);
where {
	w dl_client_state=:{app_linker_state}
		#! (x,app_linker_state)
			= f app_linker_state;
		= (x, {dl_client_state & app_linker_state = app_linker_state});
};

MainLibrary	:== 0;
			
:: *DLClientState
	= { 
	// client identification
		id							:: !ProcessSerialNumber
	,	initial_link				:: !Bool
		
	// application linker state
	,	app_linker_state			:: !*State
	
	// client window
	,	client_window				:: !ClientWindow
	
	// support for block dynamics (only one
	,	dynamic_ids					:: !*DynamicID
	
	// Library implementation
	,	cs_main_library_name		:: !String
	,	cs_type_tables				:: !*{#TypeTable}
	
	,	cs_dynamic_info				:: !*{#DynamicInfo}
	
	,	cs_library_instances		:: !*LibraryInstances	// all info specific to a library instance
	,	cs_main_library_instance_i	:: !Maybe !Int
	
	,	cs_intra_type_equalities	:: !*EqTypesState
	
	,	cs_type_implementation_table	:: *TypeImplementationTable
	
	,	cs_to_and_from_graph	:: !ToAndFromGraphTable	
	
	,	cs_n_fixed_available_types	:: !Maybe !Int
	
	,	do_dump_dynamic			:: !Bool
	
	,	cs_n_lazy_dynamics		:: !Int						// first free dynamic
	
	,	cs_lazy_dynamic_index_to_dynamic_id	:: !*{!Maybe !Int}		// indexed by lazy_dynamic_index (rt) with No meaning not initialized, Yes is initialized and dynamic id is the integer

	,	cs_share_runtime_system	:: !Bool
	
	,	cs_conversion			:: ![ConversionInfo]
	};
	
:: ConversionInfo
	= {
		ci_version						:: !Version
	,	ci_has_from_graph_been_added	:: !Bool
	,	ci_has_to_graph_been_added		:: !Bool
	};
	
instance DynamicIDs DLClientState
where {
	new_dynamic_id dl_client_state=:{dynamic_ids}
		# (id,dynamic_ids)
			= new_dynamic_id dynamic_ids;
		= (id,{dl_client_state & dynamic_ids = dynamic_ids});
		
	free_dynamic_id id dl_client_state=:{dynamic_ids}
		# dynamic_ids
			= free_dynamic_id id dynamic_ids;
		= {dl_client_state & dynamic_ids = dynamic_ids};
		
	is_valid_id id dl_client_state=:{dynamic_ids}
		# dynamic_ids
			= is_valid_id id dynamic_ids;
		= {dl_client_state & dynamic_ids = dynamic_ids};

	is_valid_id2 id dl_client_state=:{dynamic_ids}
		# (ok,dynamic_ids)
			= is_valid_id2 id dynamic_ids;
		= (ok,{dl_client_state & dynamic_ids = dynamic_ids});

};

acc_dynamic_ids :: (!*DynamicID -> (.x,!*DynamicID)) !*DLClientState -> (.x,!*DLClientState);
acc_dynamic_ids f dl_client_state=:{dynamic_ids}
	# (x,dynamic_ids)
		= f dynamic_ids;
	= (x,{dl_client_state & dynamic_ids = dynamic_ids});
	
DefaultDLClientState :: !*DLClientState;
DefaultDLClientState
	= { 
	// client identification
		id					= DefaultProcessSerialNumber
	,	initial_link		= False
		
	// application linker state
	,	app_linker_state	= EmptyState
	
	// client window
	,	client_window		= DefaultClientWindow
	
	// support for block dynamics
	,	dynamic_ids			= default_dynamic_id
	
	// Library implementation
	,	cs_main_library_name	= {}
	,	cs_type_tables			= {}
	,	cs_dynamic_info			= {}
	,	cs_library_instances	= default_library_instances
	,	cs_main_library_instance_i	= Nothing

	,	cs_intra_type_equalities	= default_eq_types_state
	,	cs_type_implementation_table = default_type_implementation_table
	,	cs_to_and_from_graph		= default_elemU
	,	cs_n_fixed_available_types	= Nothing
	
	,	do_dump_dynamic			= False
	,	cs_n_lazy_dynamics		= INITIAL_LAZY_DYNAMIC_INDEX
	,	cs_lazy_dynamic_index_to_dynamic_id	= createArray INITIAL_LAZY_DYNAMIC_INDEX Nothing
	,	cs_share_runtime_system	= False
	,	cs_conversion			= []
	};
	
// ADDED
instance AddMessage DLClientState
where {
	AddMessage linker_message dl_client_state=:{app_linker_state}
		#! app_linker_state
			= AddMessage linker_message app_linker_state;
		= {dl_client_state & app_linker_state = app_linker_state};
		
	IsErrorOccured dl_client_state=:{app_linker_state}
		#! (ok,app_linker_state)
			= IsErrorOccured app_linker_state;
		= (ok,{dl_client_state & app_linker_state = app_linker_state});
		
	GetLinkerMessages dl_client_state=:{app_linker_state}
		#! (messages,app_linker_state)
			= GetLinkerMessages app_linker_state;
		= (messages,{ dl_client_state & app_linker_state = app_linker_state });
		
	SetLinkerMessages messages dl_client_state=:{app_linker_state}
		#! app_linker_state
			= SetLinkerMessages messages app_linker_state;
		= {dl_client_state & app_linker_state = app_linker_state};
};

// ClientWindows
import expand_8_3_names_in_path;

// ids
timer_id 	:== 0;
free_id		:== timer_id + 1;

openClientWindow :: !String !ProcessSerialNumber !*DLServerState !(IOState !*DLServerState) -> !(!*DLServerState,!(IOState !*DLServerState));
openClientWindow client_name client_id s io
	/*
	** - multiple clients lazily linked from same project file probably need different names
	*/		
	// get dl_client_state for client_id
	#! (ok,dl_client_state,s)
		= RemoveFromDLServerState client_id s;
	| not ok
		= abort "openClientWindow (internal error)";
	#! (client_window,dl_client_state)
		= dl_client_state!client_window;
	#! ({visible_window_ids},s)
		= s!global_client_window;

	// generate unique id for client window
	#! (dl_client_states,s)
		= acc_dl_client_states (\dl_client_states -> (dl_client_states,[])) s;
	#! (dl_client_states,ids)
		= collect_ids dl_client_states [] visible_window_ids;
	#! window_id
		= find_out_unique_window_id (sort ids) free_id;
		
	#! dl_client_state
		= { dl_client_state &
			client_window	= { client_window & client_window_id = window_id }
		};
	#! s
		= { s &
			dl_client_states = [dl_client_state:dl_client_states]
		};
	#! io
		= DEBUG_MODE io (OpenWindows [window_def window_id] io);
	= (s,io);
where {
	collect_ids [] l ids
		= (l,ids);
	collect_ids [dl_client_state:dl_client_states] l ids
		#! ({visible_client_window,client_window_id},dl_client_state)
			= dl_client_state!client_window;
		| not visible_client_window
			= collect_ids dl_client_states [dl_client_state:l] ids;	
			= collect_ids dl_client_states [dl_client_state:l] [client_window_id:ids];
		
	find_out_unique_window_id :: [Int] !Int -> !Int;	
	find_out_unique_window_id [] cnt
		= cnt;
	find_out_unique_window_id [a:aa] cnt
		| a < free_id
			= find_out_unique_window_id aa cnt;
			
		| a == cnt	
			= find_out_unique_window_id aa (inc cnt);
			= cnt;
		
	// Client window specification
	window_def window_id
		= ScrollWindow window_id window_pos window_title
			(ScrollBar (Thumb 0) (Scroll 4)) 
			(ScrollBar (Thumb 0) (Scroll 4))
			picture_domain
			minimum_window_size
			initial_window_size
			update_function
			[GoAway (go_awayClientWindow window_id client_id)];
			
	where {
		go_awayClientWindow window_id client_id s=:{global_client_window={visible_window_ids}} io
			| isMember window_id visible_window_ids
				// client has already been killed
				#! (global_client_window=:{visible_window_ids},s)
					= s!global_client_window;
				#! visible_window_ids 
					= filter (\visible_window_id -> window_id <> window_id) visible_window_ids;
				#! io
					= CloseWindows [window_id] io;
				#! s
					= { s &
						global_client_window = {global_client_window & visible_window_ids = visible_window_ids}	
					};	
				= (s,io);
				
				#! io
					= KillClient2 client_id io;
				= (s,io);
					
		(ascent,descent,_,leading)
			= FontMetrics monaco_font;
		line_height 
			= ascent + descent + leading;
			
		window_pos
			= (100,100);
		window_title
			= expand_8_3_names_in_path client_name;
	
		window_width
			= 1000;
		window_height
			= 100;	
		picture_domain
			= ((0,0),(min_client_width,min_client_height));
		minimum_window_size
			= initial_window_size; 
		initial_window_size
			= (min_client_width,min_client_height);

		update_function _ s 
			= (s,[]);		
	}
}

// Global settings for client windows
monaco_font
	# (ok,font)=SelectFont /*"Monaco"*/ "Courier" [] 9;
	| ok
		= font;
		
instance toString LinkerMessage
where {
	toString (LinkerError msg)
		= "Error: " +++ msg;
	toString (LinkerWarning msg)
		= "Warning: " +++ msg;
	toString (Verbose msg)
		= msg;
};

min_client_width	:== 250;
min_client_height	:== 250;

pl []
	= "";
pl [x:xs]
	= toString x +++ (pl xs);

updateClientWindow :: !*DLServerState !(IOState *DLServerState) -> (!*DLServerState,!(IOState *DLServerState));
updateClientWindow s io
	// collect messages
	#! (dl_client_states,s)
		= acc_dl_client_states (\dl_client_states -> (dl_client_states,[])) s;
	#! (dl_client_states,messages)
		= collect_messages dl_client_states [] [];
	#! io
		= case length messages of {
				0
					-> io;
				1
					#! io
						= foldl draw_client_window io messages;
					-> io;
				_
					-> abort "meedere messages";
		};
	#! (s,io)
		= foldl change_picture_domain (s,io) messages;	
	= ({s & dl_client_states = dl_client_states},io);
where {
	change_picture_domain (s,io) (id_client_window,messages)
		#! (ascent,descent,_,leading)
			= FontMetrics monaco_font;
		#! line_height
			= ascent + descent + leading;
			
		// compute new picture domain
		#! height_picture_domain
			= max (length messages * line_height) min_client_height;
		#! width_picture_domain
			= max (foldl (\max_width msg -> max max_width (FontStringWidth (toString msg) monaco_font) ) 0 messages) min_client_width;
		= ChangePictureDomain id_client_window ((0,0),(width_picture_domain,height_picture_domain)) s io;
	
	draw_client_window io (id_client_window,messages)
		#! draw_functions
			= [SetFont monaco_font,draw_linker_messages messages (leading + ascent) (ascent + descent + leading)];
		#! io
			= ChangeUpdateFunction id_client_window (\_ s -> (s,draw_functions)) io;
			
		// under macOS: enforce a redraw of the (entire) window
		#! io
			= sel_platform io (DrawInWindow id_client_window draw_functions io);
		= io;
	where {
		(ascent,descent,_,leading)
			= FontMetrics monaco_font;
			
		draw_linker_messages [] y line_height picture
			= picture;
		draw_linker_messages [msg:msgs] y line_height picture
			#! picture
				= MovePenTo (0,y) picture;
		
			#! picture
				= DrawString (toString msg) picture;
			= draw_linker_messages msgs (y + line_height) line_height picture;
	}
	
	// collect all messages for windows that need to be updated
	collect_messages :: !*[*DLClientState] !*[*DLClientState] [(!Int,!LinkerMessages)] -> *(*[*DLClientState],[(Int,[LinkerMessage])]);
	collect_messages [] dl_client_states messages
		= (dl_client_states,messages);
	collect_messages [dl_client_state:dl_client_states] new_dl_client_states messages
		#! (messages0,dl_client_state)
			= GetLinkerMessages dl_client_state;
			
		#! (client_window=:{n_messages,visible_client_window,client_window_id},dl_client_state)
			= dl_client_state!client_window;
		| n_messages == (length messages0) || not visible_client_window
			= collect_messages dl_client_states [dl_client_state:new_dl_client_states] messages;
		
			#! dl_client_state
				= { dl_client_state &
					client_window	= { client_window & n_messages = length messages0 }
				};				
			= collect_messages dl_client_states [dl_client_state:new_dl_client_states] [(client_window_id,messages0):messages];
}

/*
	removeClientWindow
	
	Task:
	It registers the window id as occupied of the client being closed. The window id *cannot* be released because
	it might contain error messages which the user may want to see first.
	
	If, however no errors have occured, the window is closed immediately	
*/
removeClientWindow :: !*DLClientState !*DLServerState !(IOState *DLServerState) -> (!*DLServerState,!(IOState !*DLServerState));
removeClientWindow dl_client_state=:{id,client_window={client_window_id,visible_client_window}} s io
	#! (ok,dl_client_state)
		= IsErrorOccured dl_client_state
	| ok
		// no errors; just close the window
		/*
			perhaps the user should be given the chance to close the window herself because she may want
			to read warnings. For debugging purposes its perhaps the way to go.
		*/
		= closeClientWindow dl_client_state s io;
		
		// errors; window remains visible
		#! s
			= case visible_client_window of {
				True
					#! (global_client_window,s)
						= s!global_client_window;
					#! s
						= { s &
							global_client_window = { global_client_window & visible_window_ids = [client_window_id:global_client_window.visible_window_ids]}
						};
					-> s;
				False
					-> s;
			}
		= (s,io);
where {
	closeClientWindow dl_client_state=:{client_window} s io
		#! (client_window_id,client_window)
			= client_window!client_window_id;
		#! io
			= CloseWindows [client_window_id] io;
		= (s,io);
} // removeClientWindow

Ps []
	= "";
Ps [d:ds]
	= toString d +++ ", " +++ (Ps ds);
		
// 
HandleRequestResult :: (!Bool,!ProcessSerialNumber,!*DLServerState,(IOState !*DLServerState)) -> (!*DLServerState,IOState !*DLServerState);
HandleRequestResult (remove_state,client_id,s,io)
	// platform independent ...; check for errors
	#! ((messages,ok),s)
		= selacc_app_linker_state client_id get_error_and_messages s;
		
	// update client windows
	
	// als window nog niet geopened, dan openen
	#! (s,io)
		= updateClientWindow s io;

	// remove client if necessary
	#! (s,io)
		= case remove_state of {
			True
				#! (_,removed_dl_client_state,s)
					= RemoveFromDLServerState client_id s;
				#! (s,io)
					= removeClientWindow removed_dl_client_state s io;
				-> (s,io);
					
			False
				-> (s,io);
		};
		
	// check for error fatal for client application
	| not ok
		# io
			= abort ("!kk"  +++ (pr_linker_message messages "")) //KillClient2 client_id io;
		= (s,io);
		
		= (s,io);
where {
	
	get_error_and_messages state 
		#! (messages,state)
			= GetLinkerMessages state;		
		#! (ok,state)
			= IsErrorOccured state;
		= ((messages,ok),state);
} // HandleRequestResult

pr_linker_message [] s
	= s;
pr_linker_message [LinkerError x:xs] s
	# new_s = "LinkerError:\t " +++ x +++ "\n";
	= pr_linker_message xs (s +++ new_s);
pr_linker_message [LinkerWarning x:xs] s
	# new_s = "LinkerWarning:\t " +++ x  +++ "\n";
	= pr_linker_message xs (s +++ new_s);
pr_linker_message [Verbose x:xs] s
	# new_s = "Verbose:\t " +++ x  +++ "\n";
	= pr_linker_message xs (s +++ new_s);

app_state ::  (!*State -> !*State) !*DLClientState -> !*DLClientState;
app_state f dl_client_state=:{app_linker_state}
	= { dl_client_state & app_linker_state = f app_linker_state };
	

acc_state ::  (!*State -> (!.x,!*State)) !*DLClientState -> !(!.x,*DLClientState);
acc_state f dl_client_state=:{app_linker_state}
	# (x,app_linker_state)
		= f app_linker_state;
	= (x,{dl_client_state & app_linker_state = app_linker_state});
	
class AppPdState s
where {
	app_pd_state :: !(*PDState -> !*PDState) !*s -> !*s
};

instance AppPdState DLClientState
where {
	app_pd_state f dl_client_state
		= app_state (\s=:{pd_state} -> {s & pd_state = f pd_state}) dl_client_state
};

instance AppPdState State
where {
	app_pd_state f state=:{pd_state}
		= {state & pd_state = f pd_state};
};

class AccPdState s
where {
	acc_pd_state :: !(*PDState -> (!.x,!*PDState)) !*s -> (!.x,!*s)
};

instance AccPdState State
where {
	acc_pd_state f state=:{pd_state}
		#! (x,pd_state)
			= f pd_state;
		= (x,{ state & pd_state = pd_state});
};

instance AccPdState DLClientState
where {
	acc_pd_state f dl_client_state=:{app_linker_state}
		#! (x,app_linker_state)
			= acc_pd_state f app_linker_state;
		= (x,{dl_client_state & app_linker_state = app_linker_state});
};

// --------------------------------------------------------------------------------------------------------------------------
// VERSION MANAGEMENT OF CONVERSION FUNCTIONS

:: ConvertFunctions = {
		graph_to_string :: [Version]
	,	string_to_graph :: [Version]
	};
	
default_convertfunctions :: !ConvertFunctions;
default_convertfunctions 
	= { ConvertFunctions |
		graph_to_string = []
	,	string_to_graph = []
	};
		
/*
** Two situations at the moment, looking for
** - an appropriate graph_to_string function (write)
**   The highest major and minor version are being used to store dynamics. 
** - an appropriate string_to_graph function (read)
**   The expected and required major version numbers *must* match. Because
**   minor version number stand for non-structural bugfixes, the highest
**   minor version is taken.
**
** The situation is different when using unique and/or lazy read and written
** dynamics. An unique dynamic should probably always be saved using the 
** major version used during storing of the dynamic, the minor could be the 
** most recent. This is also valid for a lazily read or written dynamic.
**
** The major version number is mainly for (large) structural changes to the
** conversion functions e.g. the arity of each function is stored in five
** bits, hence an arity of maximal 31 is the limit. This can be improved by
** making the reasonable assumption that a partial arity of 30 should be
** enough. The full arity whatever it is can then be represented by zero. In
** this case zero is interpreted differently, so a major version change is
** necessary.
** An example for minor change is a check that the arity of the function is
** smaller than the 31-limit. This change is minor because it does not affect
** the interpretation of the dynamic.
**
** hex ASCII representation of the 4 byte version number:
** 0	(msb): reserved e.g. flags for endianess, without pointers/with pointers, uniqueness or not
** 1 		 : major, higher part
** 2 		 : major, lower part
** 3		 : minor 
*/	

eager_read_version :: !Version !*DLClientState !*DLServerState -> (!Bool,!Version,!*DLClientState,!*DLServerState);	
eager_read_version {major=major_required} dl_client_state dl_server_state=:{convert_functions={string_to_graph}} 
	#! minors
		= filter (\{major} -> major == major_required) string_to_graph;
	| isEmpty minors
		#! msg
			= "No string_to_graph function with major version " +++ toString major_required +++ " present"
		#! dl_client_state
			= AddMessage (LinkerError msg) dl_client_state;
		= (False,DefaultVersion,dl_client_state,dl_server_state);
		
	// at least one minor present
	= (True,last minors,dl_client_state,dl_server_state);
	
eager_write_version :: !*DLClientState !*DLServerState -> (!Bool,!Version,!*DLClientState,!*DLServerState);	
eager_write_version dl_client_state dl_server_state=:{convert_functions={graph_to_string=[]}}
	= abort "eager_write_version; there are no conversion functions";

eager_write_version dl_client_state dl_server_state=:{convert_functions={graph_to_string}}
	= (True,last graph_to_string,dl_client_state,dl_server_state); 
	
import ExtString;
import directory_structure;

GetDynamicLinkerDirectory :: !*DLServerState -> (!String,!*DLServerState);
GetDynamicLinkerDirectory dl_server_state=:{application_path}
	= (application_path +++ "\\" +++ DS_CONVERSION_DIR,dl_server_state);
	


InitServerState :: !*DLServerState (IOState !*DLServerState) -> (!*DLServerState,(IOState !*DLServerState));
InitServerState dl_server_state=:{convert_functions} io
	#! (dlink_dir,dl_server_state)
		= GetDynamicLinkerDirectory dl_server_state;
	#! ((ok,dlink_path),io)
		= accFiles (pd_StringToPath dlink_dir) io
	| not ok
		= abort "InitServerState: internal error 1";
			
	#! ((dir_error,dir_entries),io)
		= accFiles (getDirectoryContents dlink_path) io
	| dir_error <> NoDirError
		= abort "InitServerState: internal error 2";

	#! (graph_to_string,string_to_graph)
		= build_conversions dir_entries [] [];
	#! convert_functions
		= { convert_functions &
			graph_to_string = sortBy less_version graph_to_string 
		,	string_to_graph = sortBy less_version string_to_graph
		};
	#! dl_server_state
		= { DLServerState | dl_server_state &
			convert_functions 	= convert_functions
		};
	= (dl_server_state,io);
where {
	// smallest major and minor at start of the version list
	less_version {major=major1,minor=minor1} {major=major2,minor=minor2}
		| major1 < major2
			= True;
			| major1 == major2
				= minor1 < minor2;
				= False;

// foldSt
	build_conversions [] graph_to_string string_to_graph
		= (graph_to_string,string_to_graph);
	build_conversions [{fileName}:ds] graph_to_string string_to_graph
		#! (found,s_prefix)
			= starts copy_graph_to_string_0x fileName;
		| not found
			#! (found,s_prefix)
				= starts copy_string_to_graph_0x fileName;
			| not found
				= build_conversions ds graph_to_string string_to_graph;
				
				// a string_to_graph function found
				#! version
					= from_base_i fileName 16 s_prefix 8;
				= F fileName build_conversions ds graph_to_string [toVersion version:string_to_graph];
					
			// a graph_to_string function
			#! version
				= from_base_i fileName 16 s_prefix 8;
			= F fileName build_conversions ds [toVersion version:graph_to_string] string_to_graph;

	copy_graph_to_string_0x
		=> copy_graph_to_string +++ "_0x";
		
	copy_string_to_graph_0x
		=> copy_string_to_graph +++ "_0x";
}

instance TypeTableOps DLClientState
where {
	AddReferenceToTypeTable type_table_reference dl_client_state
		# (cs_type_tables,dl_client_state)
			= get_type_tables dl_client_state;
		# (type_table_index,cs_type_tables)
			= AddReferenceToTypeTable type_table_reference cs_type_tables;
		# dl_client_state
			= { dl_client_state &
				cs_type_tables = cs_type_tables
			};
		= (type_table_index,dl_client_state);
		
	AddTypeTable type_table_index type_table dl_client_state
		# (cs_type_tables,dl_client_state)
			= get_type_tables dl_client_state;
		# cs_type_tables
			= AddTypeTable type_table_index type_table cs_type_tables;
		# dl_client_state
			= { dl_client_state &
				cs_type_tables = cs_type_tables
			};
		= dl_client_state;			
};

get_type_tables :: !*DLClientState -> *(*{#*TypeTable},*DLClientState);
get_type_tables dl_client_state=:{cs_type_tables}
	= (cs_type_tables,{dl_client_state & cs_type_tables = {}});
	
get_ets :: !*DLClientState -> *(!*EqTypesState,*DLClientState);
get_ets dl_client_state=:{cs_intra_type_equalities}
	= (cs_intra_type_equalities,{dl_client_state & cs_intra_type_equalities = default_eq_types_state});

get_type_implementation_table :: !*DLClientState -> (!*TypeImplementationTable,!*DLClientState);
get_type_implementation_table dl_client_state=:{cs_type_implementation_table}
	= (cs_type_implementation_table,{dl_client_state & cs_type_implementation_table = default_type_implementation_table});

instance DynamicInfoOps DLClientState
where {
	UpdateDynamicInfo dynamic_info_index dynamic_info dl_client_state
		# (cs_dynamic_info,dl_client_state)
			= get_dynamic_infos dl_client_state;
		# cs_dynamic_info
			= UpdateDynamicInfo dynamic_info_index dynamic_info cs_dynamic_info
		# dl_client_state
			= { dl_client_state &
				cs_dynamic_info = cs_dynamic_info
			};
		= dl_client_state;			
};

get_dynamic_infos dl_client_state=:{cs_dynamic_info}
	= (cs_dynamic_info,{dl_client_state & cs_dynamic_info = {}});
		
instance Library_Instances DLClientState
where {
	AddLibraryInstance dynamic_index library_name type_table_i dl_client_state=:{cs_library_instances}
		# (library_instance_i,cs_library_instances)
			= AddLibraryInstance dynamic_index library_name type_table_i cs_library_instances;
		= (library_instance_i,{dl_client_state & cs_library_instances = cs_library_instances});
};

import ExtArray;
from type_io_common import PredefinedModuleName;
from utilities import foldSt;

print_type_implementation_table :: !*DLClientState -> !*DLClientState;
print_type_implementation_table dl_client_state
	# (n_type_implementations,dl_client_state)
		= dl_client_state!cs_type_implementation_table.teit_n_type_implementations;
	# dl_client_state
		= AddMessage (Verbose "Type Implementation Table (format: module_name<type_table_i,library_instance_i>\nor ?(disk_library_instance,rt_lazy_dynamic_index)") dl_client_state;
	= loopAst print_type_implementation dl_client_state n_type_implementations;
where {
	print_type_implementation type_implementation_ref dl_client_state
		// get implementation type to be printed
		# ({tei_type_implementations,tei_chosen_type_implementation},dl_client_state)
			= dl_client_state!cs_type_implementation_table.teit_type_implementations_a.[type_implementation_ref];
			
		// get names
		# ((type_name,_,_,_,_),dl_client_state)
			= get_info_library_instance_type_reference (hd tei_type_implementations) dl_client_state;
			
		// determine the type implementation used, if any
		# (used_implementation,dl_client_state)
			= case tei_chosen_type_implementation of {
				Nothing
					-> ("No",dl_client_state);
				Just chosen_type
					# (chosen_type,dl_client_state)
						= get_info_library_instance_type_reference chosen_type dl_client_state;
					-> (make_module_name chosen_type,dl_client_state);
			};
			
		// convert equivalences to string
		# (type_equivalences_as_string,dl_client_state)
			= foldSt f tei_type_implementations ("",dl_client_state);
			
		# msg
			= toString type_implementation_ref +++ " (" +++ type_name +++ ","+++ used_implementation +++ "):" +++ type_equivalences_as_string;
		# dl_client_state
			= AddMessage (Verbose msg) dl_client_state;
			
		= dl_client_state;
		// 0: Tree; module_name<library_instance_i,type_table_i>; chosen: none		
	where {
		make_module_name (type_name,module_name,type_table_i,library_instance_i,tio_type_ref)
			= module_name +++ "<" +++ toString type_table_i +++ "," +++ toString library_instance_i +++ (make_string tio_type_ref) +++ ">";
		where {
			make_string {tio_type_without_definition,tio_tr_module_n,tio_tr_type_def_n}
				#! s1
					= if (isNothing tio_type_without_definition) "Nothing" ("Just " +++ fromJust tio_type_without_definition);
				#! s2
					= toString tio_tr_module_n
				#! s3
					= toString tio_tr_type_def_n
				= EXTEND_TYPE_INFO (" ! " +++ s1 +++ " " +++ s2 +++ " " +++ s3) "";
		};
			
		f library_instance_type_reference (s,dl_client_state)
			# (type_info,dl_client_state)
				= get_info_library_instance_type_reference library_instance_type_reference dl_client_state;
			= (s +++ " " +++  make_module_name type_info,dl_client_state);
	};
};

get_info_library_instance_type_reference (LIT_TypeReference (LibRefViaLazyDynamic disk_library_instance rt_lazy_dynamic_index type_table_i) tio_type_ref) dl_client_state
//	= (("een type naam","een module naam"),dl_client_state);
//	= abort "get_info_library_instance_type_reference: unimplemented";
	= (("?","?",disk_library_instance,rt_lazy_dynamic_index,tio_type_ref),dl_client_state);
	
get_info_library_instance_type_reference (LIT_TypeReference (LibRef library_instance_i) tio_type_ref) dl_client_state
	# (type_table_i,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
	# (type_name,module_name,dl_client_state)
		= get_names tio_type_ref type_table_i dl_client_state;
	= ((type_name,module_name,type_table_i,library_instance_i,tio_type_ref),dl_client_state);
where {
	get_names {tio_type_without_definition=Just type_name} type_table_i dl_client_state
		= (type_name,PredefinedModuleName,dl_client_state);
		
	get_names {tio_type_without_definition=Nothing,tio_tr_module_n,tio_tr_type_def_n} type_table_i dl_client_state
	    #! (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,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].tio_td_name;
		# 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;
	     
		= (type_name,module_name,dl_client_state);
};
	
	
get_from_graph_function_address2 :: (!Maybe !Version) !*DLClientState -> (ToAndFromGraphEntry,ToAndFromGraphEntryIndex,!*DLClientState);
get_from_graph_function_address2 maybe_version dl_client_state
	#! (cs_to_and_from_graph,dl_client_state)
		= get_cs_to_and_from_graph dl_client_state;
	#! (x1,x2,cs_to_and_from_graph)
		= get_from_graph_function_address maybe_version cs_to_and_from_graph;
	#! dl_client_state
		= { dl_client_state &
			cs_to_and_from_graph = cs_to_and_from_graph
		};
	= (x1,x2,dl_client_state);

get_to_graph_function_address2 :: (!Maybe !Version) !*DLClientState -> (Maybe (ToAndFromGraphEntry,ToAndFromGraphEntryIndex),!*DLClientState);
get_to_graph_function_address2 maybe_version dl_client_state
	#! (cs_to_and_from_graph,dl_client_state)
		= get_cs_to_and_from_graph dl_client_state;
	#! (x,cs_to_and_from_graph)
		= get_to_graph_function_address maybe_version cs_to_and_from_graph;
	#! dl_client_state
		= { dl_client_state &
			cs_to_and_from_graph = cs_to_and_from_graph
		};
	= (x,dl_client_state);

get_cs_to_and_from_graph dl_client_state=:{cs_to_and_from_graph}
	= (cs_to_and_from_graph,{dl_client_state & cs_to_and_from_graph = default_elemU});

instance symbol_n_to_offset DLClientState
where {
	symbol_n_to_offset file_n symbol_n dl_client_state
		#! (symbol_index,dl_client_state)
			= acc_state (\state -> symbol_n_to_offset file_n symbol_n state) dl_client_state;
		= (symbol_index,dl_client_state);
};

check_whether_implementation_is_available :: !Int !String !*DLClientState -> (!Bool,!*DLClientState);
check_whether_implementation_is_available library_instance_i label_name dl_client_state
	#! (bool,_,dl_client_state)
		= check_whether_implementation_is_available2 library_instance_i label_name dl_client_state;
	= (bool,dl_client_state);


check_whether_implementation_is_available2 :: !Int !String !*DLClientState -> (!Bool,!Maybe !(!Int,!Int),!*DLClientState);
check_whether_implementation_is_available2 library_instance_i label_name dl_client_state
	#! (li_library_initialized,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_library_initialized;
	| not li_library_initialized
		#! dl_client_state
			= dl_client_state;

		= (False,Nothing,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
			= dl_client_state;
		= (False,Nothing,dl_client_state);
		
	#! (file_n,symbol_n)
		= fromJust maybe_file_n_symbol_n;
	#! (maybe_address,dl_client_state)
		= isLabelImplemented file_n symbol_n dl_client_state;
	= (isJust maybe_address,maybe_file_n_symbol_n,dl_client_state);

findLabel :: !String !Int !*DLClientState -> (!Maybe !(!Int,!Int),!*DLClientState);
findLabel label_name library_instance_i dl_client_state
	#! (names_table_element,dl_client_state)
		= find_symbol_in_symbol_table_new label_name (\index dl_client_state -> dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_names_table.[index]) dl_client_state;
	#! label_name_found
		= get names_table_element;
	= (label_name_found,dl_client_state);
where {
	get (NamesTableElement _ symbol_n file_n _)
		= Just (file_n,symbol_n);
	get _
		= Nothing;
};

isLabelImplemented :: !Int !Int !*DLClientState -> (!Maybe !Int,!*DLClientState);
isLabelImplemented file_n symbol_n dl_client_state
	#! (first_symbol_n,dl_client_state)
		= dl_client_state!app_linker_state.marked_offset_a.[file_n];
	#! (marked,dl_client_state)
		=  dl_client_state!app_linker_state.marked_bool_a.[first_symbol_n+symbol_n];
	| not marked
		= (Nothing,dl_client_state);
		
	#! (symbol_address,dl_client_state)
		= acc_state (address_of_label2 file_n symbol_n) dl_client_state;
	= (Just symbol_address,dl_client_state);

isTypeImplemented :: !LibraryInstanceTypeReference !*DLClientState -> (!Maybe !(!String,[String]),*DLClientState);
isTypeImplemented library_instance_type_reference dl_client_state
	= isTypeImplemented2 allSt library_instance_type_reference dl_client_state;

isAnyConstructorOfTypeImplemented :: !LibraryInstanceTypeReference !*DLClientState -> (!Maybe !(!String,[String]),*DLClientState);
isAnyConstructorOfTypeImplemented library_instance_type_reference dl_client_state
	= isTypeImplemented2 anySt library_instance_type_reference dl_client_state;

from type_io_common import UnderscoreSystemModule;
import predefined_types;

isTypeImplemented2 all_or_any (LIT_TypeReference (LibRefViaLazyDynamic _ _ _) _) dl_client_state
	= (Nothing,dl_client_state);

isTypeImplemented2 all_or_any (LIT_TypeReference (LibRef library_instance_i) tio_type_reference=:{tio_type_without_definition=Nothing}) 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;
	#! (type_name,labels_implementing_type,dl_client_state)
		= get_type_label_names tio_type_reference li_type_table_i dl_client_state;

	#! (implementation_is_available,dl_client_state)
		= all_or_any (check_whether_implementation_is_available library_instance_i) labels_implementing_type dl_client_state;	
//		= anySt (check_whether_implementation_is_available library_instance_i) labels_implementing_type dl_client_state;
	| implementation_is_available
		#! dl_client_state
			= dl_client_state <<- ("isTypeImplemented2",labels_implementing_type);

		= (Just (type_name,labels_implementing_type),dl_client_state);
		= (Nothing,dl_client_state);

isTypeImplemented2 _ (LIT_TypeReference (LibRef library_instance_i) tio_type_reference=:{tio_type_without_definition=Just type_name}) 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;
	#! (type_name,labels_implementing_type,dl_client_state)
		= get_type_label_names tio_type_reference li_type_table_i  dl_client_state;
	= (Just (type_name,labels_implementing_type),dl_client_state);

has_strict_field :: !Int !Int !Bool !StrictnessList -> !Bool;
has_strict_field _ _ True _
	= True;
has_strict_field i arity _ tio_st_args_strictness
	| i == arity
		= False;
		= has_strict_field (inc i) arity (arg_is_strict i tio_st_args_strictness) tio_st_args_strictness;

get_type_label_names :: !TIO_TypeReference !Int !*DLClientState -> (!String,[String],!*DLClientState);
get_type_label_names {tio_type_without_definition=Just type_name} type_table_i dl_client_state
	#! list
		= filter (\{pt_type_name} -> type_name == pt_type_name) PredefinedTypes;
	| isEmpty list
		= abort ("get_type_label_names; internal error; unknown predefined type '" +++ type_name +++ "'");

	#! pt_constructor_names
		= map (\label_name -> gen_label_name True (label_name,UnderscoreSystemModule) '?') (hd list).pt_constructor_names;
	= (type_name,pt_constructor_names,dl_client_state);
	
get_type_label_names type_def=:{tio_tr_module_n,tio_tr_type_def_n} type_table_i dl_client_state
	#! (string_table_i,dl_client_state)
		= dl_client_state!cs_type_tables.[type_table_i].tt_type_io_state.tis_string_table;
	#! (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_i;
		
	// list with constructor names
	#! ({tio_td_name,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_i;
	#! (label_names,dl_client_state)
		= case tio_td_rhs of {
			(TIO_AlgType defined_symbols)
				-> foldSt (generate_algebraic_type_label_names module_name string_table_i) defined_symbols ([],dl_client_state);
			TIO_RecordType tio_record_type
				-> generate_record_label module_name string_table_i type_name tio_record_type dl_client_state;
			TIO_SynType _  
				| True <<- ("get_type_label_names; elimination of synonym types should still be done")
				-> ([],dl_client_state);
			s
				| True <<- (s,type_name)
				-> abort "lsdfklsfdksdk" <<- s;
		};
	= (type_name,label_names,dl_client_state);
	
where {
	generate_record_label module_name string_table_i record_descriptor_name {tio_rt_constructor={tio_ds_arity,tio_ds_index},tio_rt_fields} dl_client_state
		#! (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;
		#! is_strict_record
			= has_strict_field 0 tio_ds_arity False tio_st_args_strictness;

		#! r_prefixed_label
			= gen_label_name True (record_descriptor_name,module_name) 'r';
		| is_strict_record
			// strict
			#! t_prefixed_label
				= gen_label_name True (record_descriptor_name,module_name) 't';
			#! c_prefixed_label
				= gen_label_name True (record_descriptor_name,module_name) 'c';
			= ([r_prefixed_label,t_prefixed_label,c_prefixed_label],dl_client_state);
			
			// non strict record
			= ([r_prefixed_label],dl_client_state);

	generate_algebraic_type_label_names module_name string_table_i {tio_ds_ident,tio_ds_index,tio_ds_arity} (label_names,dl_client_state)
		#! constructor_name
			= get_name_from_string_table tio_ds_ident string_table_i;
	
		#! (tio_cons_type=:{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;

		#! is_strict_constructor
			= has_strict_field 0 tio_ds_arity False tio_st_args_strictness;

		#! d_prefixed_label
			= gen_label_name True (constructor_name,module_name) 'd';
		| is_strict_constructor
			// strict
			#! k_prefixed_label
				= gen_label_name True (constructor_name,module_name) 'k';
			#! n_prefixed_label
				= gen_label_name True (constructor_name,module_name) 'n';

			#! label_names
				= [k_prefixed_label,d_prefixed_label,n_prefixed_label:label_names];
			=  (label_names,dl_client_state);

			// non-strict
			#! label_names
				= [d_prefixed_label:label_names];
			=  (label_names,dl_client_state);
}

acc_library_instances :: .(*LibraryInstances -> *(.a,*LibraryInstances)) !*DLClientState -> *(.a,*DLClientState);
acc_library_instances f dl_client_state=:{cs_library_instances}
	# (x,cs_library_instances)
		= f cs_library_instances;
	= (x,{dl_client_state & cs_library_instances = cs_library_instances});
	
acc_lis_library_instances :: .(*{#*LibraryInstance} -> *(.a,*{#*LibraryInstance})) !*LibraryInstances -> *(.a,*LibraryInstances);
acc_lis_library_instances f cs_library_instances=:{lis_library_instances}
	# (x,lis_library_instances)
		= f lis_library_instances;
	= (x,{cs_library_instances & lis_library_instances = lis_library_instances} );
	
acc_library_instance :: .(*{!NamesTableElement} -> *(.a,*{!NamesTableElement})) !*LibraryInstance -> *(.a,*LibraryInstance);	
acc_library_instance f library_instance=:{li_names_table}
	# (x,li_names_table)
		= f li_names_table;
	= (x,{library_instance & li_names_table = li_names_table});

acc_names_table :: !Int !*DLClientState -> *(.{!NamesTableElement},*DLClientState);	
acc_names_table library_instance_i dl_client_state
	= acc_library_instances (\library_instances -> acc_lis_library_instances select_library_instance library_instances) dl_client_state;
where {
	select_library_instance library_instances 
		# (library_instance,library_instances)
			= replace library_instances library_instance_i default_library_instance;
			
		# (x,library_instance)
			= acc_library_instance (\nt -> (nt,{})) library_instance;
		# library_instances
			= { library_instances & [library_instance_i] = library_instance };
		= (x,library_instances); 
}

instance findImplementationType DLClientState
where {
	findImplementationType litr dl_client_state
		# (type_implementation_table,dl_client_state)
			= get_type_implementation_table dl_client_state;
		# (is_type_equation,type_implementation_ref,type_implementation_table)
			= findImplementationType litr type_implementation_table;
		# dl_client_state
			= { dl_client_state &
				cs_type_implementation_table	= type_implementation_table
			};
		= (is_type_equation,type_implementation_ref,dl_client_state);
};

print_type_table_reference :: !Int !TIO_TypeReference !{#*TypeTable} -> (!String,{#*TypeTable});
print_type_table_reference type_table_i {tio_tr_module_n,tio_tr_type_def_n,tio_type_without_definition=Nothing} type_tables
	#! (string_table_i,type_tables)
		= type_tables![type_table_i].tt_type_io_state.tis_string_table;
	#! (tio_td_name,type_tables)
		= type_tables![type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_type_defs.[tio_tr_type_def_n].tio_td_name;
	#! type_name
		= get_name_from_string_table tio_td_name string_table_i;
	= (type_name,type_tables);
print_type_table_reference type_table_i {tio_type_without_definition=Just type_name} type_tables
	= (type_name,type_tables);
	
get_lazy_dynamic_index_to_dynamic_id :: !*DLClientState -> *(!*{!Maybe !Int},!*DLClientState);
get_lazy_dynamic_index_to_dynamic_id dl_client_state=:{cs_lazy_dynamic_index_to_dynamic_id}
	= (cs_lazy_dynamic_index_to_dynamic_id,{dl_client_state & cs_lazy_dynamic_index_to_dynamic_id = {} });

// utility
get_number_of_type_tables :: *DLClientState -> *(Int,*DLClientState);
get_number_of_type_tables dl_client_state
	// get number of type tables
	# (type_tables,dl_client_state)
		= get_type_tables dl_client_state;
	# (n_type_tables,type_tables)
		= usize type_tables
	# dl_client_state
		= { dl_client_state & cs_type_tables = type_tables };
	= (n_type_tables,dl_client_state);