implementation module _SystemDynamic

use_type_context no yes				:== no		// change also in convertDynamics.icl


import StdFile
import StdEnv
from StdBool import not
import StdArray
import StdDynamicTypes
F a b :== b
H a b = F a b

import code from "read_function.obj"

import StdDynamicLowLevelInterface

COPY_TO_DYNAMIC_RTS :== True

DynamicDefaultOptions	:== 0x00000000
HyperStrictEvaluation	:== 0x00000001

// Type of a dynamic (internal, change also convertDynamic.icl,overloading.icl, conversion-functions)
// ----------------------------------------------------------------------------------------------------------------------
:: T_ypeObjectType
	= T_ypeConsSymbol T_ypeName T_ypeID [T_ypeObjectType]
	| P_laceholder (T_ypeObjectType -> T_ypeObjectType) (T_ypeObjectType -> T_ypeObjectType) T_ypeObjectType
	
:: T_ypeName	:== {#Char}		

:: T_ypeID
	// internal dynamic
	= ModuleID DummyModuleID				// within application
	
	// external dynamic
//	| DiskID !Int					// on disk (or other medium)
	| RunTimeID !Int				//	id (both encoded/decoded dynamic rts)
	| LazyRunTimeID !Int !Int 		// id {dynamic_index (both rt and disk)} {disk library instance w.r.t. main dynamic}

_coerce :: !T_ypeObjectType !T_ypeObjectType -> (Bool, [T_ypeObjectType])
_coerce type1 type2
	= _unifyQ type1 type2 True

_unify :: !T_ypeObjectType !T_ypeObjectType -> (Bool, [T_ypeObjectType])
_unify type1 type2 
	= _unifyQ type1 type2 False
		
_unifyQ :: !T_ypeObjectType !T_ypeObjectType !Bool -> (!Bool, ![T_ypeObjectType])
_unifyQ type1 type2 coerce
	#! (ok,ind,type_refs)
		= _unify2 type1 type2 [] []
	| not ok
		= (False,ind)
		
		#! equivalent_type_definitions
			= decode (doreqS ("CheckTypeDefinitions" +++ encode type_refs))
		| equivalent_type_definitions
			= (True,ind)
			= (False,ind)
where
	_unify2 :: !T_ypeObjectType !T_ypeObjectType ![T_ypeObjectType] ![TypeReference] -> (!Bool,![T_ypeObjectType],![TypeReference])
	_unify2 (T_ypeConsSymbol type_name1 type_id1 type_args1) (T_ypeConsSymbol type_name2 type_id2 type_args2) indirection_list type_refs
		// " -> " should be shared with compiler
		| type_name1 == " -> " && type_name2 == type_name1
			= _unify_args type_args1 type_args2 indirection_list type_refs
			
		# (equal,type_name,module_name1,module_name2)
			= compare_type_name type_name1 type_name2
		| equal //type_name1 == type_name2
			# type_ref
				= create_type_ref type_name type_id1 type_id2 module_name1 module_name2
			= _unify_args type_args1 type_args2 indirection_list [type_ref:type_refs]

			= (False,indirection_list,type_refs)
	where
		create_type_ref type_name type_id1 type_id2 module_name1 module_name2
			# type_ref
				= { TypeReference |
					tr_type_name	= type_name
				,	tr_module_name1	= module_name1 
				,	tr_module_name2	= module_name2
				,	tr_library1		= determine_library_id type_id1
				,	tr_library2		= determine_library_id type_id2
				}
			= type_ref

		determine_library_id (RunTimeID rt_id)
			= Number rt_id
		determine_library_id (ModuleID module_id)
			# (module_name,address)
				= get_module_id module_id
			= Address address

		_unify_args [] [] indirection_list type_refs
			= (True,indirection_list,type_refs)
		_unify_args [t1:t1s] [t2:t2s] indirection_list type_refs
			# (ok,indirection_list,type_refs)
				= _unify2 t1 t2 indirection_list type_refs
			| ok
				= _unify_args t1s t2s indirection_list type_refs
				
				= (False,indirection_list, type_refs)
		_unify_args _ _ indirection_list type_refs
			= (False,indirection_list,type_refs)
			
		compare_type_name type_name1 type_name2
			= compare_type_name 0 (min s_type_name1 s_type_name2) 
		where 
			compare_type_name i limit
				| i == limit
					= abort ("_SystemDynamic; type name without defining module <" +++ type_name1 +++ "> - <" +++ type_name2 +++ ">")
				| type_name1.[i] == '\''
					= (True,type_name1 % (0,dec i),type_name1 % (inc i,dec s_type_name1),type_name2 % (inc i,dec s_type_name2))
					
				| type_name1.[i] == type_name2.[i]
					= compare_type_name (inc i) limit
					
					= (False,"","","")
					
			s_type_name1 = size type_name1
			s_type_name2 = size type_name2

	_unify2 tp=:(T_ypeConsSymbol type_name1 _ type_args1) var=:(P_laceholder _ _ _) indirection_list type_refs
		#! indirection_list
			= if coerce indirection_list (_subst_variable  tp var indirection_list)
		= (True,indirection_list,type_refs) // coerce
		
	_unify2 var=:(P_laceholder _ _ _) tp=:(T_ypeConsSymbol type_name1 _ type_args1) indirection_list type_refs
		#! indirection_list
			= _subst_variable  tp var indirection_list
		= (True,indirection_list,type_refs)

	_subst_variable :: T_ypeObjectType T_ypeObjectType [T_ypeObjectType] -> ![T_ypeObjectType]
	_subst_variable _ _  _
		= code inline {
			fill_a 0 1	
			push_a 2
			push_a 2
			fill _Cons 2 _hnf 5
			pop_a 3
		}

/****************************************************************************************\
****
****			U n d o   I n d i r e c t i o n s
****
\****************************************************************************************/

_undo_indirections :: a ![T_ypeObjectType] -> a
_undo_indirections x list = code {
	.o 2 0												||  list | x
	:_undo_indirections
	||		print "_undo_indirections\n"
			push_a 1									||  list | x | list			
	:_undo_indirection_loop
			eq_desc _Nil 0 0
			jmp_true _end_undo_indirection_loop			||  list | x | Nil
			eq_desc _Cons 2 0
			jmp_true _undo_this_indirection				||  list | x | Cons T Next
			buildAC "StdDynamics: Unknown Descriptor in indirectionlist"
			jmp _maRCo_abort
	
	:_undo_this_indirection								||  list | x | Cons T next
			push_arg 0 2 1								||  list | x | Cons T next | T
			
			push_a 0									||  list | x | Cons T next | T | T
			push_a 1									||  list | x | Cons T next | T | T | T
			fill e__SystemDynamic_dP_laceholder 2 _hnf 2	||  list | x | Cons T next | P_laceholder T T
			
			push_arg 1 2 2								||  list | x | Cons T next | P_laceholder T T | next
			update_a 0 2								||  list | x | next        | P_laceholder T T | next
	.keep 1 2
			pop_a 2										||  list | x | next
			jmp _undo_indirection_loop
	
	:_end_undo_indirection_loop							||  list | x | Nil
			update_a 1 2								||  x | x | Nil
			pop_a 2										||  x
			jsr_eval 0
	.d 1 0
			rtn
			
	||=================
	||   abort call
	||=================
	:_maRCo_abort
			jsr_eval	0
			jmp e_StdMisc_sabort

}

pointer_to_dynamic :: !Pointer -> Dynamic
pointer_to_dynamic p = cast_to_a p

cast_to_a :: !Pointer -> a
cast_to_a x = code {
	pop_a 0
	}
	
import StdDynamicSharedBuffer

// file_name should contain an *absolute* path
readDynamic :: String *f -> (Bool,Dynamic,*f) | FileSystem f
readDynamic file_name files
//	#! (ok,file_name)
//		= GetShortPathName (GetCurrentDirectory +++ "\\" +++ file_name)

	#! (ok,file_name)
		= ConvertToAbsolutePath file_name
	| not ok
		= abort ("readDynamic; error in OS GetShortPathName" +++ "<" +++ file_name +++ ">")
/*
	| COPY_TO_DYNAMIC_RTS
		# (ok,file,dynamic_rts_string)
			= CreateSharedBufferFromFile GetHandleToServer file_name
		| not ok 
			= abort "readDynamic"
			
		# (ok,dynamic_header,file)
			= read_dynamic_header file
		| not ok
			= abort "readDynamic"
		
		#! (ok,dyn,file)
			= make_dynamic file_name dynamic_header file dynamic_rts_string
				
		| CloseSharedBufferFromFile file
		= (ok,dyn,files)
*/

	// open dynamic; dynamic rts accesses file contai
	#! (ok,dynamic_header=:{block_table_i,graph_i},file,files)
		= open_dynamic_as_binary file_name files
	| not ok
		#! (_,files)
			= close_dynamic_as_binary file files
		= (False,undef,files)
	
	#! (ok,dyn,file)
		= make_dynamic file_name dynamic_header file ""
		
	#! (_,files)
		= close_dynamic_as_binary file files
	= (ok,dyn,files)

GetHandleToServer :: !HANDLE
GetHandleToServer 
	= code {
		ccall GetHandleToServer ":I"
	}
/*
** A view is only used if COPY_TO_DYNAMIC_RTS is True and dynamic_rts_string has *not* length
** zero. This string is sent to dynamic rts which uses it to access the view containing the
** dynamic.
*/
make_dynamic :: !String !DynamicHeader *f !String -> (Bool,Dynamic,!*f) | BinaryDynamicIO f
make_dynamic file_name dynamic_header=:{block_table_i,graph_i} file dynamic_rts_string
	# (ok,dyn,file)
		= case (block_table_i == 0) of
			/*
			True
				// no block table
				#! (ok,graph,file)
					= read_graph_from_dynamic dynamic_header file;
				| not ok
					= (False,undef,file);
					
				// create global dynamic info
				#! gdi
					= { GlobalDynamicInfo |
						file_name		= file_name
					,	block_table		= {}
					
					// no significance
					,	first_time		= True
					,	id				= 0
					,	graph_blocks	= {}
					,	graph_pointers 	= {}
					
					, diskid_to_runtimeid = {}
					, di_disk_to_rt_dynamic_indices = {}
					}
				-> (True,build_dynamic graph {gdid=gdi},file)
			*/
			False
				/*
				// a block table
				#! (ok,block_table,file)
					= read_block_table_from_dynamic dynamic_header file
				#! n_blocks
					= size block_table
				| not ok
					= (False,undef,file)
					
				// read graph blocks
				#! (ok,graph_blocks,file)
					= read_graph_blocks 0 n_blocks (createArray n_blocks "hallo") block_table dynamic_header file
				| not ok
					= (False,undef,file)
					
				// create global dynamic info
				#! gdi
					= { GlobalDynamicInfo |
						file_name		= file_name
					,	first_time		= True	
						
					,	block_table		= block_table
					,	id				= 0
					,	graph_blocks	= graph_blocks
					,	graph_pointers	= { {} \\ i <- [1..n_blocks] }
					
					,	diskid_to_runtimeid = {}
					,	di_disk_to_rt_dynamic_indices	= {}
					}

				# dynamic1
					= build_top_level_dynamic make_start_node_index {gdid=gdi} dynamic_header dynamic_rts_string
				*/
				#! (ok,gdid,file)
					= init_dynamic file_name dynamic_header file
				| not ok
					-> abort "_SystemDynamic; internal error"

				# dynamic1
					= build_top_level_dynamic make_start_node_index gdid dynamic_header dynamic_rts_string
				-> (True,dynamic1,file)
	= (ok,dyn,file)

init_dynamic file_name dynamic_header=:{block_table_i,graph_i} file
	// a block table
	#! (ok,block_table,file)
		= read_block_table_from_dynamic dynamic_header file
	#! n_blocks
		= size block_table
	| not ok
		= (False,undef,file)
		
	// read graph blocks
	#! (ok,graph_blocks,file)
		= read_graph_blocks 0 n_blocks (createArray n_blocks "hallo") block_table dynamic_header file
	| not ok
		= (False,undef,file)
		
	// create global dynamic info
	#! gdi
		= { GlobalDynamicInfo |
			file_name		= file_name
		,	first_time		= True	
			
		,	block_table		= block_table
		,	id				= 0
		,	graph_blocks	= graph_blocks
		,	graph_pointers	= { {} \\ i <- [1..n_blocks] }
		
		,	diskid_to_runtimeid = {}
		,	di_disk_to_rt_dynamic_indices	= {}
		}

//	# dynamic1
//		= build_top_level_dynamic make_start_node_index {gdid=gdi} dynamic_header dynamic_rts_string
	= (True,{gdid=gdi},file)
where 
	read_graph_blocks :: !Int !Int !*{String} !BlockTable !DynamicHeader !*f -> (!Bool,!{String},!*f) | BinaryDynamicIO f
	read_graph_blocks block_i n_blocks graph_blocks block_table dynamic_header=:{graph_i} file
		| block_i == n_blocks
			= (True,graph_blocks,file)

		#! block
			= block_table.[block_i]

		// read graph block
		#! (ok,file)
			= bd_seek file (block.bk_offset + graph_i) FSeekSet
		#! (graph_block,file)
			= bd_reads file block.bk_size
		| H ("**** (" +++ toString block_i +++ ") " +++ toString block.bk_size +++ "<" +++ graph_block +++ ">") not ok || (size graph_block <> block.bk_size)
			= abort "read_graph_block: dynamic is corrupt"
		= read_graph_blocks (inc block_i) n_blocks {graph_blocks & [block_i] = graph_block} block_table dynamic_header file

NF :: !.a -> .a
NF _ = code
 {
    push_a 0
    .d 1 0
    jsr _eval_to_nf
    .o 0 0
 }


:: *EncodedDynamic
	= { 
		ed_encoded_graph	:: !*{#Char}
	,	ed_dynamic_rts_info	:: !*{#Char}
	}
	
	/*
instance DefaultElem EncodedDynamic
where
	default_elem
		= { 
			ed_encoded_graph	= {}
		,	ed_dynamic_rts_info	= {}
		}
*/

class EncodedDynamic a
where 
	dynamic_to_string :: !Int !Dynamic -> (!Bool,!*a)

/*
	# (s_ed_encoded_graph,ed_encoded_graph)
		= usize ed_encoded_graph
	# ed_encoded_graph
		= WriteLong ed_encoded_graph (DYNAMIC_RTS_INFO_OFFSET - HEADER_SIZE_OFFSET) s_ed_encoded_graph

	# (s_ed_dynamic_rts_info,ed_dynamic_rts_info)
		= usize ed_dynamic_rts_info
	# ed_encoded_graph
		= WriteLong ed_encoded_graph (DYNAMIC_RTS_INFO_SIZE - HEADER_SIZE_OFFSET) s_ed_dynamic_rts_info
*/

instance EncodedDynamic String
where
	dynamic_to_string dynamic_options d
		# (ok,{ed_encoded_graph,ed_dynamic_rts_info})
			= dynamic_to_string2 dynamic_options d
			
		// size of arrays
		# (s_ed_encoded_graph,ed_encoded_graph)
			= usize ed_encoded_graph
		# (s_ed_dynamic_rts_info,ed_dynamic_rts_info)
			= usize ed_dynamic_rts_info
		# s_encoded_dynamic
			= s_ed_encoded_graph + s_ed_dynamic_rts_info
			
		// copy
		# (j,encoded_dynamic)
			= copy 0 s_ed_encoded_graph ed_encoded_graph 0 (createArray s_encoded_dynamic ' ')
//		| j == s_ed_encoded_graph
//			= abort "ok"
//			= abort "not ok"
			
		# (_,encoded_dynamic)
			= copy 0 s_ed_dynamic_rts_info ed_dynamic_rts_info j encoded_dynamic
			
		// patch encoded dynamic
		# encoded_dynamic
			= WriteLong encoded_dynamic (DYNAMIC_RTS_INFO_OFFSET - HEADER_SIZE_OFFSET) s_ed_encoded_graph
		# encoded_dynamic
			= WriteLong encoded_dynamic (DYNAMIC_RTS_INFO_SIZE - HEADER_SIZE_OFFSET) s_ed_dynamic_rts_info
		= (ok,encoded_dynamic)
	where 
		copy :: !Int !Int !{#Char} !Int !*{#Char} -> (!Int,!*{#Char})
		copy i limit src j dest
			| i == limit
				= (j,dest)
			= copy (inc i) limit src (inc j) {dest & [j] = src.[i]}
			
		/*
		MARTIJN
		*/
		
instance EncodedDynamic EncodedDynamic
where
	dynamic_to_string dynamic_options d
		= dynamic_to_string2 dynamic_options d
		
:: Wrap a 
	= { 
		wrap_info		:: !a
	}

// aanpassen van gesharde type door alle library instanties		
:: *CopyGraphToStringArguments
	= {
		cgtsa_dynamic					:: Dynamic
	,	cgtsa_code_library_instances	:: !*{#Int}
	,	cgtsa_type_library_instances	:: !*{#Int}
	,	cgtsa_range_table				:: !{#Char}
	}
	
:: *CopyGraphToStringResults
	= {
		cgtsr_encoded_dynamic			:: !*{#Char}
	,	cgtsr_code_library_instances	:: !*{#Int}
	,	cgtsr_type_library_instances	:: !*{#Int}
	,	cgtsr_lazy_dynamic_references	:: !{#LazyDynamicReference}
	}

copy_graph_to_string_OK :: !(Wrap CopyGraphToStringArguments) -> !(Wrap CopyGraphToStringResults)
copy_graph_to_string_OK _ 
	= {wrap_info={cgtsr_encoded_dynamic={},cgtsr_code_library_instances={},cgtsr_type_library_instances={},cgtsr_lazy_dynamic_references={}}}
//	= undef

copy_graph_to_string_OK2 :: !(Wrap CopyGraphToStringArguments) -> !CopyGraphToStringResults
copy_graph_to_string_OK2 _ 
	= undef


// copy_graph_to_string_new :: !Dynamic !{#Int} !String -> (!*{#Char},!*{#Int},!{String})	
	

/*	
		#! (encoded_dynamic,type_table_usage,s)
*/
	
	
/*
		# type_table_usage
			= f (NF (createArray n_library_instances TTUT_UNUSED))	// indexed by RunTimeID or indirectly by converting a ModuleID to a RunTimeID
		#! (encoded_dynamic,type_table_usage,s)
			= copy_graph_to_string d (NF type_table_usage) (NF range_table)

*/
			
//dynamic_to_string2 :: !Int !Dynamic -> (!Bool,!String)
dynamic_to_string2 :: !Int !Dynamic -> (Bool,!*EncodedDynamic)
dynamic_to_string2 dynamic_options d
	#! d1 = d
//	# (r=:{type})
//		= cast_dynamic_to_dynamic_temp d
	
	// #! is essential here.
//	#! d1
//		= use_type_context d { r & type =  NF (export_type type) }
//	#! d1
//		= { r & type = type }
		

/*
	# {type}
		= cast_dynamic_to_dynamic_temp d
	= case type of
		T_ypeContext module_id type
			# (module_name,address)
				= get_module_id module_id
			# s
				= doreqS ("GetTypeInfo" +++ 
					module_name +++ "\n" +++
					toString address +++ "\n")
			-> abort ("dynamic_to_string: TypeContext <" +++ module_name +++ "> " +++ (toString address) +++ s)
		_
			-> abort "dynamic_to_string: iets anders"
*/

/*
	# s
		= doreqS ("GetLibraryInfo\n")
	| True
		= abort ("addresses" +++ s)
*/

	// step 1: obtain graph_to_string conversion function from the dynamic rts
	#! copy_graph_to_string2
		= doreqS ("GetGraphToStringFunction")
	#! copy_graph_to_string_addr
		= FromStringToInt copy_graph_to_string2 0
	# (_,copy_graph_to_string)
		= read_function ((FromStringToInt copy_graph_to_string2 0))
		
	// step 2: evaluate HyperStrictOption
	#! d 
		= if ((dynamic_options bitand HyperStrictEvaluation) == 0) d (NF d)
	# n_bytes_to_skip
		= 4
	| size copy_graph_to_string2 == n_bytes_to_skip
		= abort "dynamic_to_string"

		// step 3: convert graph to string representation
		# n_library_instances
			= FromStringToInt copy_graph_to_string2 (n_bytes_to_skip + RID_N_TYPE_TABLES_OFFSET)
		# range_table
			= copy_graph_to_string2 % (n_bytes_to_skip,dec (size copy_graph_to_string2))
		# type_table_usage
			= f (NF (createArray n_library_instances TTUT_UNUSED))	// indexed by RunTimeID or indirectly by converting a ModuleID to a RunTimeID

		// NEW ...
		#! cgtsa
			= { 
				cgtsa_dynamic					= d
			,	cgtsa_code_library_instances	= createArray n_library_instances TTUT_UNUSED
			,	cgtsa_type_library_instances	= createArray n_library_instances TTUT_UNUSED
			,	cgtsa_range_table				= range_table
			}
			
		
		#! copy_graph_to_string_argument = /* NF */ {wrap_info = cgtsa}
		#! ({wrap_info = {cgtsr_encoded_dynamic,cgtsr_type_library_instances,cgtsr_code_library_instances,cgtsr_lazy_dynamic_references}})
			= copy_graph_to_string copy_graph_to_string_argument
//		| False <<- ("hallo1",cgtsr_code_library_instances,'\n',cgtsr_type_library_instances,'n',cgtsr_lazy_dynamic_references)
//			= undef
/*
		| size cgtsr_code_library_instances>=0
			= abort (toString (size cgtsr_code_library_instances))

		= abort (toString (size cgtsr_code_library_instances))
*/
//		= abort "kk"

		#! dynamic_rts_info
			= doreqS ("GetDynamicRTSInfo" +++ encode (help_type_checker cgtsr_type_library_instances) +++ encode cgtsr_lazy_dynamic_references)

		# encoded_dynamic1
			= { //default_elem &
				ed_encoded_graph	= cgtsr_encoded_dynamic
			,	ed_dynamic_rts_info	= dynamic_rts_info
			}
		= (True,encoded_dynamic1)


		// ... NEW
		
/*
:: *CopyGraphToStringResults
	= {
		cgtsr_encoded_dynamic			:: !*{#Char}
	,	cgtsr_code_library_instances	:: !*{#Int}
	,	cgtsr_type_library_instances	:: !*{#Int}
	,	cgtsr_lazy_dynamic_references	:: !{#LazyDynamicReference}
	}
*/



/*
		#! (encoded_dynamic,type_table_usage,s)
			= copy_graph_to_string d (NF type_table_usage) (NF range_table)

		#! s
			= help_type_checker2 s

		#! dynamic_rts_info
			= doreqS ("GetDynamicRTSInfo" +++ encode (help_type_checker type_table_usage) +++ encode s)

		# encoded_dynamic1
			= { //default_elem &
				ed_encoded_graph	= encoded_dynamic
			,	ed_dynamic_rts_info	= dynamic_rts_info
			}
		= (True,encoded_dynamic1)
*/
where 
	help_type_checker2 :: !{#LazyDynamicReference} -> !{#LazyDynamicReference}		// # makes the array unboxed
	help_type_checker2 i = i

	help_type_checker :: !*{#Int} -> !*{#Int}
	help_type_checker i = i
	
	encode_type_table_usage :: !*{#Int} -> !*{#Char}
	encode_type_table_usage type_table_usage
		#! encoded_type_table_usage
			= createArray (s_type_table_usage << 2) ' '
		= encode_type_table_usage 0 0 encoded_type_table_usage
	where
		encode_type_table_usage i offset encoded_type_table_usage
			| i == s_type_table_usage
				= encoded_type_table_usage
				
				# encoded_type_table_usage
					= WriteLong encoded_type_table_usage offset type_table_usage.[i]
				= encode_type_table_usage (inc i) (offset + 4) encoded_type_table_usage
	
		s_type_table_usage
			= size type_table_usage
	

	f :: {#Int} -> {#Int}
	f k = k


/*		
copy_graph_to_string :: a !*{#Char} -> (!String,!*{#Char})
copy_graph_to_string s d
	= ("aa",d)
*/

/*
copy_graph_to_string :: a !*{#Int} !String -> (!String,!*{#Int})
copy_graph_to_string graph type_table_usage range_id_table
	= ("aa",type_table_usage)
*/		
		

	//	= abort ("*****" +++ toString (size copy_graph_to_string2))  //(True,copy_graph_to_string d)
	/*
where 
		
	export_type :: !T_ypeObjectType -> !T_ypeObjectType	
	export_type (T_ypeContext module_id type)
		#! new_type
			= change_type type
		= new_type
	where 
		change_type :: !T_ypeObjectType -> !T_ypeObjectType
		change_type (T_ypeConsSymbol "Dynamic" _)
			// also the type of nested dynamics must be exported to ensure correct
			// references to their type tables.
			= abort "export_type: nested dynamics not yet supported"


		change_type (T_ypeConsSymbol type_name type_args)
			= T_ypeSpecOnDisk type_table_path module_name type_name (map change_type type_args)

		type_table_path
			=: doreqS ("GetTypeTablePath" +++ 
				module_name +++ "\n" +++
				toString address +++ "\n")

		(module_name,address)
			= get_module_id module_id

		
	collect_type_names (P_laceholder _ _ _)
		= abort "aa"
		
/*
:: T_ypeObjectType
	= T_ypeConsSymbol T_ypeName [T_ypeObjectType]
	| P_laceholder (T_ypeObjectType -> T_ypeObjectType) (T_ypeObjectType -> T_ypeObjectType) T_ypeObjectType
	| T_ypeContext DummyModuleID T_ypeObjectType
	
:: T_ypeName	:== {#Char}

*/
		
		*/
		
cast_dynamic_to_dynamic_temp :: !Dynamic -> DynamicTemp
cast_dynamic_to_dynamic_temp _
	= code {
		pop_a 	0
	}


string_to_dynamic :: !String -> (!Bool,!Dynamic)
string_to_dynamic dynamic_as_string
	# (ok,file,dynamic_rts_string)
		= CreateSharedBufferFromPageFile GetHandleToServer dynamic_as_string
	| not ok
		= abort "not ok"

	# (ok,dynamic_header,file)
		= read_dynamic_header file
	| not ok
		= abort "readDynamic"
	
	#! (ok,dyn,file)
		= make_dynamic "string_to_dynamic" dynamic_header file dynamic_rts_string
			
	| CloseSharedBufferFromPageFile file
	= (ok,dyn)
	
writeDynamic :: String !Int Dynamic *f -> (Bool,*f) | FileSystem f
writeDynamic file_name dynamic_options dynamic_value files
	#! (ok,file,files)
		= fopen file_name FWriteData files
	| not ok
		# (_,files)
			= fclose file files
		= (False,files)

/* OLD
	# (ok,dynamic_string)
		= dynamic_to_string dynamic_options dynamic_value
	| not ok
		= (False,files)
	# file
		= fwrites dynamic_string file
*/

// NEW ...
	# (ok,encoded_dynamic)
		= dynamic_to_string dynamic_options dynamic_value
	| not ok
		= (False,files)
		
	#! file
		= write_encoded_dynamic encoded_dynamic file
// ... NEW		

	# (ok,files)
		= fclose file files
	= (ok,files)

//write_encoded_dynamic :: !*EncodedDynamic !*File -> !*File	
write_encoded_dynamic {ed_encoded_graph,ed_dynamic_rts_info} file
	// Offset/Size
	# (s_ed_encoded_graph,ed_encoded_graph)
		= usize ed_encoded_graph
	# ed_encoded_graph
		= WriteLong ed_encoded_graph (DYNAMIC_RTS_INFO_OFFSET - HEADER_SIZE_OFFSET) s_ed_encoded_graph

	# (s_ed_dynamic_rts_info,ed_dynamic_rts_info)
		= usize ed_dynamic_rts_info
	# ed_encoded_graph
		= WriteLong ed_encoded_graph (DYNAMIC_RTS_INFO_SIZE - HEADER_SIZE_OFFSET) s_ed_dynamic_rts_info



//	# ed_encoded_graph
//		= { ed_encoded_graph & [ 0 ] = '!' }
		
/*
	// write encoded graph
	#! file
		= fwritei 16 file
	#! file
		= fwritei s_ed_encoded_graph file
		
	// write encoded dynamic rts info
	#! file
		= fwritei (16 + s_ed_encoded_graph) file
	#! file
		= fwritei s_ed_dynamic_rts_info file
*/		
	#! file
		= fwrites ed_encoded_graph file
	#! file
		= fwrites ed_dynamic_rts_info file
	= file
where
	s_ed_dynamic_rts_info
		= size ed_dynamic_rts_info
		

/*
{ed_encoded_graph,ed_dynamic_rts_info}
	#! s_encoded_graph
		= size ed_encoded_graph)
	#! file
		= fwritei 16 file
	#! file
		= fwritei  file
		
	#! file
		= fwritei 
	

*/

// Interface
// remove & use StdDynamicLowLevelInterface
doreqS :: !String -> !.{#Char}
doreqS _ =
	code { 
		ccall DoReqS "S-S"
	}

read_function :: !Int -> (!Bool,a)
read_function _ =
	code {
		jmp read_function
	}


/*

*/
read_function2 :: !Int -> (!Bool,a)
read_function2 _ =
	code {
		jmp read_function
	}

	
// Dynamic representation
unpackdynamic :: Dynamic -> (a,b)
unpackdynamic d = code {
        .inline unpackdynamic
        repl_args 2 2
        .end
}

packdynamic :: a b -> Dynamic
packdynamic a b = code {
        .inline packdynamic
        fillh _Tuple 2 2
        .end
}
	
:: DynamicTemp = E.a: {
		value	:: a					// do not change order see boxing of arguments in gts_copy.c
	,	type	:: T_ypeObjectType
	}
	
:: UnifyCoerceContext = {
		module_i	:: !Int
	,	library_id	:: !Int
	}
	
// utilities
FromIntToString :: !Int -> !String 
FromIntToString v
	= { (toChar v), (toChar (v>>8)), (toChar (v>>16)), (toChar (v>>24)) }
	
FromStringToInt :: !String !Int -> !Int
FromStringToInt array i
	= (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24)
where
	v0= array.[i]
	v1
		= array.[i+1]
	v2 
		= array.[i+2]
	v3  
		= array.[i+3]


/*
/*
** the dynamic to be decoded is identified by (encoded_graph_i,graph)
**
**
** ugid				= returned by the dynamic rts on readDynamic's behalf.
** ulid				= local id of dynamic (within ugid; 0 for a top-level dynamic)
** encoded_graph_i	= index of dynamic to be decoded (0 for a top-level dynamic)
** graph			= string encoding of the *complete* dynamic to be decoded
*/

build_dynamic :: !Int !Int !String -> Dynamic;
build_dynamic ugid ulid encoded_graph_i graph
	// needed:
	// 1. correct string_to_graph routine
	// 2. descriptor address table i.e. expanded descriptor prefix table for ulid

	#! (string_to_graph,descriptor_address_table)
		= doreqS ("build_dynamic",ugid,ulid);
	= f 
	
*/

// change also string_to_graph.c; gts_gdi.c
:: GlobalDynamicInfo = {
	// general
		file_name		:: !String
	,	first_time		:: !Bool

	// block table
	,	id				:: !Int				// id from Dynamic Linker
	,	block_table		:: !BlockTable		
	,	graph_blocks	:: !{String}		// filepointer to start of graph
	,	graph_pointers	:: !{#.{Int}}
	
	// 
	,	diskid_to_runtimeid	:: !{#Int}		// conversion from DiskId (disguished as RunTimeId) to *real* runtimeID (library instances)
	,	di_disk_to_rt_dynamic_indices	:: !{#Int} // conversion from disk to runtime index for lazy dynamics
	}
	
// The # above ensure that no ARRAY node is inserted.
	
gdi_default :: !GlobalDynamicInfo
gdi_default
	= { GlobalDynamicInfo |
	// general
		file_name		= ""
	,	first_time		= True

	// block table
	,	id				= 0
	,	block_table		= {}
	,	graph_blocks	= {}
	,	graph_pointers	= {}
	,	 diskid_to_runtimeid = {}
	,	di_disk_to_rt_dynamic_indices = {}
	}
		
	
// force compiler to pass entire records instead of all entries
:: GlobalDynamicInfoDummy = {
		gdid			:: !GlobalDynamicInfo
	}

//import DebugUtilities
	
build_dynamic :: !String !GlobalDynamicInfoDummy -> Dynamic
build_dynamic graph gdid=:{gdid={file_name,block_table}}
	#! graph_i = 0
	| H ("build_dynamic <" +++ toString graph_i +++ ">") True
	#! s_adr
		= doreqS ("ComputeDescAddressTable" +++ file_name +++ "\n")
	# (ok,copy_string_to_graph)
		= read_function ((FromStringToInt s_adr 0))
	# (graph2,_)
		= copy_string_to_graph (s_adr % (4,size s_adr)) graph_i graph gdid
	= graph2
	
	
is_block_i_already_present block_i gdid=:{gdid={graph_pointers}}
	= size graph_pointers.[block_i] <> 0

:: Pointer = Pointer

// Ideas:
// - If there are no references more to a particular block and not all blocks have been built, then there is
//   a space leak because the graph_pointers-array still contains pointers to at least one entry node.
// - Version information per block instead per dynamic. In case of a copied dynamic i.e. a reference to a
//   piece of graph in another dynamic, another version of the string_to_graph-routine might have been used.
//   This version of the conversion routine should then be called.
// - Reading blocks lazily. The dynamic run-time system must guarantee that the dynamic from which the blocks
//   are lazily read remains available until there are no references to that dynamic or all blocks have been
//   read from the dynamic.
// - If during building a block some external node i.e. in an another block is referenced more than once, then
//   the build_block-closure is built multiple times. This could be optimized.
// - Can internal entry nodes occur in absence of existential types?
//
// The function below with its local function should *not* call the garbage collector because the pointer to
// an already existing piece of graph can change because of gc.
extract_already_built_graph :: !Int !Int !GlobalDynamicInfoDummy -> Pointer
extract_already_built_graph block_i en_node_i gdid=:{gdid={graph_pointers}}
	#! (p,graph_pointers) = graph_pointers![block_i,en_node_i]
	# (g,_) = convert_to_dynamic p
//	# (g,_)
//		= convert_to_dynamic graph_pointers.[block_i,en_node_i]
	= g
where
	convert_to_dynamic :: Int -> (Pointer,!Int)
	convert_to_dynamic _
		= code {
				pushI	0
		}

/*
// remove & use StdDynamicLowLevelInterface	
LinkBlock :: !String !Bool !Int !Int -> (!Int,!Int,!String)
LinkBlock file_name first_time id block_i
	#! msg
		= "Compute2DescAddressTable" +++ file_name +++ 
			"\n" +++ toString first_time +++
			"\n" +++ toString id +++ 
			"\n" +++ toString block_i +++ 
			"\n"
	#! s_adr
		= doreqS msg
	// id string_to_graph addresses_of_needed_descriptor_names
	= (FromStringToInt s_adr 0,FromStringToInt s_adr 4,s_adr % (8,size s_adr))
*/

import memory_mapped_files

	
file_size file 
	# (_,file)
		= fseek file 0 FSeekEnd
	# (size,file)
		= fposition file
	# (_,file)
		= fseek file 0 FSeekSet
	= (size,file)
		
/*
DWORD GetCurrentDirectory(
  DWORD nBufferLength,  // size, in characters, of directory buffer
  LPTSTR lpBuffer       // pointer to buffer for current directory
)
 
*/

build_top_level_dynamic :: !Int !GlobalDynamicInfoDummy !DynamicHeader !String -> Dynamic
build_top_level_dynamic node_index gdid=:{gdid={id,first_time,file_name,block_table,graph_blocks}} dynamic_header dynamic_rts_string
	| H "build_top_level_dynamic" True
	// UseLinkBlock ...
//	# (extra_string,file)
//		= copy_to_dynamic_rts COPY_TO_DYNAMIC_RTS dynamic_header file
	#! msg
		= "Compute2DescAddressTable" +++ file_name +++ // GetCurrentDirectory +++ "\\" +++ file_name +++ 
			"\n" +++ toString first_time +++
			"\n" +++ toString id +++ 
			"\n" +++ toString block_i +++
			
			(if (COPY_TO_DYNAMIC_RTS && (size dynamic_rts_string <> 0))
				("\n" +++ dynamic_rts_string +++ "\n")
			
				"\n")
	#! s_adr
		= doreqS msg
//	| True
//		= abort (toString (size s_adr))
		
	
	// ... UseLinkBlock
		
	// initialize if it is the first message for current dynamic file

	#! (gdid,s_adr)
		= case first_time of
			True
				// laziness on my part
				#! (diskid_to_runtimeid,j)
					= from_string 0 s_adr
				// lazy dynamics ...
				#! (di_disk_to_rt_dynamic_indices,j)
					= from_string j s_adr
				// ... lazy dynamics

				#! s_adr
					= s_adr % (j,dec (size s_adr))
				#! gdid
					= { gdid &
						gdid	=  { gdid.gdid &
									first_time	= False
								,	id			= FromStringToInt s_adr 0
								,	diskid_to_runtimeid = diskid_to_runtimeid
								,	di_disk_to_rt_dynamic_indices = di_disk_to_rt_dynamic_indices
								}
					}
				-> (gdid,s_adr)
			_
				-> (gdid,s_adr)
	#! graph_block
		= graph_blocks.[block_i]

	# (ok,copy_string_to_graph)
		= read_function2 ((FromStringToInt s_adr 4))

	// copy_string_to_graph
	// input:
	// - entry node needed
	// - offsets to be update din the the graph_pointers table
	
	// output:
	// - graph belong to entry node
	// (- destructively updated graph_pointers table)
	# bk_entries // bk_offset
		= if (size (block_table.[block_i].bk_entries) == 0) 
			{block_table.[block_i].bk_offset - block_table.[block_i].bk_offset}	// and block_table.[block_i].bk_n_node_entries == 0
			(to_help_the_type_checker { en_offset - block_table.[block_i].bk_offset \\ en_offset <-: block_table.[block_i].bk_entries })		

	#! (graph2,_)
		= copy_string_to_graph 
			(s_adr % (8,size s_adr)) 			// %edx
			0									// %ebx offset in graph_block 
			graph_block							// %ecx graph
			gdid								// -4(%esi) unboxed GlobalDynamicInfo
			bk_entries 							// -8(%esi)
			block_i 							// %eax
			en_node_i							// (%esp)

/*
		= copy_string_to_graph 
			"linker" 							//%edx
			1 									//%ebx
			"graph_block" 						//%ecx
			gdid								//-4(%esi) // GlobalDynamicInfo (unboxed)
			bk_entries 	//-8(%esi)
			2 									//%eax
			255								//(%esp)
*/	
		
		// netter zou zijn om de graph_pointers uniek te maken
	= /*H "built top level dynamic"*/ graph2 //(F "built" graph2,0)
where
	block_i
		= 0
	en_node_i
		= 0
	block
		= block_table.[block_i]
	
	s 
		= ">> block_i: " +++ toString block_i +++ "  en_node_i:" +++ toString en_node_i
		
build_lazy_block :: !Int !Int -> Pointer
build_lazy_block node_index lazy_dynamic_index
	| is_internal_reference node_index
		= abort "build_lazy_block; internal error; internal reference"
	#! debug_string
		= "external reference to block " +++ toString (get_block_i node_index) +++ " with entry node " +++ toString (get_en_node_i node_index) +++ " with lazy dynamic index " +++ (toString lazy_dynamic_index)

/*
	#! msg
		= "Compute2DescAddressTable" +++ file_name +++ 
			"\n" +++ toString first_time +++
			"\n" +++ toString id +++ 
			"\n" +++ toString block_i +++ 
			"\n"
*/
	#! msg
		= "RegisterLazyDynamic" +++ (encode lazy_dynamic_index) +++
			"\n"
	#! s_adr
		= doreqS msg
//	| True
//		= abort (toString (size s_adr))
		
	#! ((file,file_name),j)
		= to_help_the_type_checker (from_string  0 s_adr)
	
//	from_string :: !Int !{#Char} -> (a,!Int)
	# (ok,file)
		= OpenExistingSharedBuffer2 file
	| not ok
		= abort "init_dynamic: OpenExistingSharedBuffer failed"
		
	# (ok,dynamic_header,file)
		= read_dynamic_header file
		
	# (ok,gdid,file)
		= init_dynamic file_name dynamic_header file
	| not ok
		= abort "init_dynamic: init_dynamic failed"
		
//	= abort ("!!build_lazy_block " +++ gdid.gdid.file_name) //abort ((toString i) +++ " - " +++ (toString j))
	

	// laziness on my part
	#! (diskid_to_runtimeid,j)
		= from_string j s_adr
	// lazy dynamics ...
	#! (di_disk_to_rt_dynamic_indices,j)
		= from_string j s_adr
	// ... lazy dynamics

	#! s_adr
		= s_adr % (j,dec (size s_adr))
	#! gdid
		= { gdid &
			gdid	=  { gdid.gdid &
						first_time	= False
					,	id			= FromStringToInt s_adr 0
					,	diskid_to_runtimeid = diskid_to_runtimeid
					,	di_disk_to_rt_dynamic_indices = di_disk_to_rt_dynamic_indices
					}
		}
	# id = FromStringToInt s_adr 0
//	| True <<- (file_name, "ID=",id, "lazy_dynamic_index=",lazy_dynamic_index)
	
	= build_block node_index gdid
where
	to_help_the_type_checker :: (!((!Int,!Int),!String),!Int) -> (!((!Int,!Int),!String),!Int)
	to_help_the_type_checker i = i
	
build_block :: !Int !GlobalDynamicInfoDummy -> Pointer //(Pointer,!Int)  /* algemeen: een stuk graaf */
build_block node_index gdid=:{gdid={id,first_time,file_name,block_table,graph_blocks}}
//	| True
//		= abort "build_block temp cancelled" 



	| H s is_external_entry_node node_index 
		= abort ("build_block: internal error" +++ toString node_index)
//	| F ("!!!node_index: " +++ toString node_index) block.bk_n_node_entries <> 0
//		= abort "build block: multiple entry nodes are unimplemented"
	| not first_time && is_block_i_already_present block_i gdid
		// blocku has already been constructed
		// There are multiple references from some decoded i.e. built block to some unbuilt 
		// i.e. undecoded block. If one of these references is evaluated, then the undecoded
		// block will be constructed.		
		= H "block already constructed" extract_already_built_graph block_i en_node_i gdid

	// USE LinkBlock ...
	// compose and send message & wait for answer
	#! msg
		= "Compute2DescAddressTable" +++ file_name +++ 
			"\n" +++ toString first_time +++
			"\n" +++ toString id +++ 
			"\n" +++ toString block_i +++ 
			"\n"
	#! s_adr
		= doreqS msg
	// ... UseLinkBlock
		
	// initialize if it is the first message for current dynamic file

	#! gdid
		= case first_time of
			True
				#! gdid
					= { gdid &
						gdid	=  { gdid.gdid &
									first_time	= False
								,	id			= FromStringToInt s_adr 0
								}
					}
				-> gdid
			_
				-> gdid
/*
	| not first_time && is_block_i_already_present block_i gdid
		// block has already been constructed
		// There are multiple references from some decoded i.e. built block to some unbuilt 
		// i.e. undecoded block. If one of these references is evaluated, then the undecoded
		// block will be constructed.		
		= H "block already constructed" extract_already_built_graph block_i en_node_i gdid
*/			
			/*
			False
				// a check should be made whether a block has already been 
				// constructed. If so, then the address of the required 
				// entry node should be given.
				
				| is_block_i_already_present block_i gdid
					// There are multiple references from some decoded i.e. built block to some unbuilt 
					// i.e. undecoded block. If one of these references is evaluated, then the undecoded
					// block will be constructed. All other references then end up here.
					//
					// It suffices to extract the proper address from theb graph_pointers table.
					-> extract_already_built_graph block_i en_node_i gdid //abort ("block_i: " +++ toString block_i +++ " is already present")
					
				-> gdid //abort ("build_block: 2nd time unimplemented" +++ toString (size s_adr))
			*/
				
	// fetch graph (semantics problem: not referentially transparent if dynamics are to be overwritten)
	// In the near future blocks may be read lazily from disk. This creates other problems because the
	// dynamic cannot be overwritten if there are still references to its encoded graph. Also if copied
	// dynamics are supported, then it is the same problem.
	#! graph_block
		= graph_blocks.[block_i]
	|  H ("@building block " +++ toString block_i) True
	
	// build graph
	// - for the time being it assumed that each block only has one entry
	//   node
	// - should create a unique array containg pointers to already built blocks. 
	// en-nodes
	# (ok,copy_string_to_graph)
		= read_function2 ((FromStringToInt s_adr 4))

	// copy_string_to_graph
	// input:
	// - entry node needed
	// - offsets to be update din the the graph_pointers table
	
	// output:
	// - graph belong to entry node
	// (- destructively updated graph_pointers table)
	# bk_entries // bk_offset
		= if (size (block_table.[block_i].bk_entries) == 0) 
			{block_table.[block_i].bk_offset - block_table.[block_i].bk_offset}	// and block_table.[block_i].bk_n_node_entries == 0
			(to_help_the_type_checker { en_offset - block_table.[block_i].bk_offset \\ en_offset <-: block_table.[block_i].bk_entries })		

	# (graph2,_)
		= copy_string_to_graph 
			(s_adr % (8,size s_adr)) 			// %edx
			0									// %ebx offset in graph_block 
			graph_block							// %ecx graph
			gdid								// -4(%esi) unboxed GlobalDynamicInfo
			bk_entries 							// -8(%esi)
			block_i 							// %eax
			en_node_i							// (%esp)

/*
		= copy_string_to_graph 
			"linker" 							//%edx
			1 									//%ebx
			"graph_block" 						//%ecx
			gdid								//-4(%esi) // GlobalDynamicInfo (unboxed)
			bk_entries 	//-8(%esi)
			2 									//%eax
			255								//(%esp)
*/	
		
		// netter zou zijn om de graph_pointers uniek te maken
	= H "Test" graph2
where
	block_i
		= get_block_i node_index
	en_node_i
		= get_en_node_i node_index
	block
		= block_table.[block_i]
	
	s 
		= ">> block_i: " +++ toString block_i +++ "  en_node_i:" +++ toString en_node_i

copy_string_to_graph2 :: !String !Int !String !GlobalDynamicInfoDummy !{#Int} !Int !Int -> (.a,!Int)
copy_string_to_graph2 adr graph_i graph gdid node_entries block_i en_node_i
 	= abort "copy_string_to_graph2"

to_help_the_type_checker i :== to_help_the_type_checker2 i
where
	to_help_the_type_checker2 :: !{#Int} -> !{#Int}
	to_help_the_type_checker2 i
		= i
	
/*
	copy_string_to_graph2 :: !String !String -> (.a,!Int)
		copy_string_to_graph2 _ _
			= code {
			.d 2 0
				jsr copy_string_to_graph2
			.o 1 0
				pushI 0
			}
*/


/*
	file -> string -> shared_memory_buffer -> string -> encoded string
	    freads    DoReqS				 ReceiveReq
	    
	- efficientie
	 het levert 3 indirecties meer op. Voor de gehele dynamic levert het 
	 ook een indirectie meer op omdat eerst de gehele string ingelezen
	 wordt en daarna start het decoderen.
	 
	- linker
	 technisch probleem, 4KB buffer 
	 

*/


FromStringToIntU :: !*{#Char} !Int -> (!Int,!*{#Char})
FromStringToIntU array i
/*
	#! (s_array,array)
		= usize array
	| F (toString i +++ " - " +++ toString s_array) i < 0 || ((i + 3) > (dec s_array))
		= abort "error"
*/		
	#! (v0,array)
		= array![i]
	#! (v1,array)
		= array![i+1]
	#! (v2,array)
		= array![i+2]
	#! (v3,array)
		= array![i+3]
	#! i
		= (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24)
	= (i,array)
	
WriteLong :: !*{#Char} !Int !Int -> !*{#Char}
WriteLong array i v
	= { array & [i] 	= (toChar v)		,	[i+1] = (toChar (v>>8)),
				[i+2]	= (toChar (v>>16))  ,	[i+3] = (toChar (v>>24))}

/*
_dynamic_unevaluated
	buildAC "dynamic unevaluated"
	jsr_eval	0		|| MV
	pushD_a	0
	pushI 2
	addI
	eqD_b e__SystemDynamic_nbuild_block 0
	pop_b
	

	jmp e_StdMisc_sabort
*/

/*
# (encoded_dynamic,type_table_usage)

	=copy_graph_to_string_new d (NF type_table_usage) (NF range_table)
*/

// used as prototype for the conversion function
copy_graph_to_string_new :: !Dynamic !{#Int} !String -> (!*{#Char},!*{#Int},!{String})
copy_graph_to_string_new _ _ _
	= ({},{},{})
	
// ----------------------------------------------------------------
ConvertToAbsolutePath file_name
	# (path,file_name1)
		= ExtractPathAndFile file_name
	# is_absolute_path
		= fst (CharIndexFunc path 0 (\c -> c <> '.' || c <> '\\'))
	| is_absolute_path 
		= (True, file_name) //abort ("absolute path" //GetShortPathName file_name
		
		 = (True, GetCurrentDirectory +++ toString path_separator +++ file_name1 )
where 
	// from ExtFile ...
//1.3
	path_separator :== '\\'
//3.1
/*2.0
	path_separator = '\\'
0.2*/


	
	ExtractPathAndFile :: !String -> (!String,!String)
	ExtractPathAndFile path_and_file 
		#! (dir_delimiter_found,i)
			= CharIndexBackwards path_and_file (size path_and_file - 1) path_separator
		| dir_delimiter_found
			# file_name_with_extension
				= path_and_file % (i+1,size path_and_file - 1)
			= (if (i == 0) (toString path_separator) (path_and_file % (0,i-1)),file_name_with_extension)
			= ("",path_and_file)
	// ... from ExtFile
			
	
	// from ExtString ...			
	CharIndexFunc  :: !String !Int (!Char -> !Bool) -> (!Bool,!Int) 
	CharIndexFunc s i f
		| i < 0 || (i == (size s))
			= (False,size s)
			
			| i < (size s)
				| f s.[i]
					= (True,i)
					= CharIndexFunc s (inc i) f
				= abort "CharIndexFunc: index out of range"
				
	CharIndexBackwards :: !String !Int !Char -> (!Bool,!Int)
	CharIndexBackwards s i char
		| i == (-1)
			= (False,size s)
			
			| s.[i] == char
				= (True,i)
				= CharIndexBackwards s (dec i) char

	// ... from ExtString

//import RWSDebug

GetShortPathName :: !String -> (!Bool,!String)
GetShortPathName long_path
//	| True <<- ("GetShortPathName",long_path)
	#! s_short_path
		= GetShortPathName_ long_path "\0" 0
	#! short_path
		= createArray s_short_path '\0'
	#! result
		= GetShortPathName_ long_path short_path s_short_path
	= (result <> 0,short_path)
where
	GetShortPathName_ :: !String !String !Int -> !Int
	GetShortPathName_ long_path short_path s_short_path
		= code {
			ccall GetShortPathNameA@12 "PssI:I"
			}

