implementation module Redirections;

import StdArray;
import UtilStrictLists;
import BitSet;
import StdMaybe;
import ExtString;

// -----------------------------------------------------------------------------------------
// Label name table
LABEL_NAME_TABLE_SIZE			:== 4096;
LABEL_NAME_TABLE_SIZE_MASK 		:== 4095;

:: *LabelNameTable
	:== *{List LabelName};
	
:: LabelName
	= {
		ln_label_name 		 :: !String
	,	ln_redirection_index :: !Int			// index in RedirectionTable
	,	ln_constructor_index :: !Int			// index in ri_constructor_infos
	};

label_name_hash :: !String -> Int;
label_name_hash symbol_name 
	# v = (simple_hash symbol_name 0 0) bitand LABEL_NAME_TABLE_SIZE_MASK;
//	| F ("label_name_hash: " +++ toString v) v < 0 || v >= LABEL_NAME_TABLE_SIZE
//		= abort "stoppen";
	= v;
where {
	// could be optimized to avoid collisions of labels 
	simple_hash string index value
		| index== size string
			= value;
			= simple_hash string (inc index) (((value<<2) bitxor (value>>10)) bitxor (string BYTE index));
}; // name_hash

class lookup_label_name a :: !String !*a -> (Maybe LabelName,!*a);

/*
instance lookup_label_name {List LabelName}	// LabelNameTable
where {
	lookup_label_name label_name label_name_table
		# label_name_value
			= label_name_hash label_name;
		# (labels,label_name_table)
			= label_name_table![label_name_value];
		# label
			= Filter (\{ln_label_name} -> ln_label_name == label_name) labels;
		| IsEmptyList label
			= (Nothing,label_name_table);
			
			= (Just (Head label),label_name_table);
};
*/
import DebugUtilities;

instance lookup_label_name RedirectionState
where {
	lookup_label_name label_name redirection_state
		# label_name_value
			= label_name_hash label_name;
//		| F ("label_name_value: " +++ toString label_name_value) True 
//			= (Nothing,redirection_state);

		# (labels,redirection_state)
//			= (Nil,redirection_state); 
			= redirection_state!rs_label_name_table.[label_name_value]; //];

//		# redirection_state
//			= get redirection_state;

		# label
			= Filter (\{ln_label_name} -> ln_label_name == label_name) labels;
		| IsEmptyList label
			= (Nothing,redirection_state);
			
			= (Just (Head label),redirection_state);
	where {
		get rs=:{rs_label_name_table}
			# (s_rs_label_name_table,rs_label_name_table)
				= usize rs_label_name_table;
			| s_rs_label_name_table <> LABEL_NAME_TABLE_SIZE
				= abort ("!!!stoppen" +++ (toString s_rs_label_name_table) +++ (label_name));
			
				= { rs & rs_label_name_table = rs_label_name_table };
	
	
	
	};
		
};








//lookup_label_name !String !*LabelNameTable -> (Maybe LabelName,!*LabelNameTable);		
			
			
insert_label_name :: LabelName !LabelNameTable -> !LabelNameTable;
insert_label_name ln=:{ln_label_name,ln_redirection_index} label_name_table
	# (s_label_name_table,label_name_table)
		= usize label_name_table;
	| F ("insert_label_name: " +++ toString (s_label_name_table)) True
	
	// it is guaranteed that label names are uniquely inserted in the table
	# label_name_value
		= label_name_hash ln_label_name;
	| F ("label_name_value: " +++ toString label_name_value) True 
	# (labels,label_name_table)
		= label_name_table![label_name_value];
	= { label_name_table & [label_name_value] = ln :! labels };
	
	= abort "skskls";

// -----------------------------------------------------------------------------------------
// Module Names Table
:: ModuleNameTable = {
		module_names		:: {#String}
	,	contains_dynamics	:: .BitSet
	};
	
default_module_name_table :: .ModuleNameTable;
default_module_name_table
	= { ModuleNameTable |
		module_names		= {}
	,	contains_dynamics	= NewBitSet 0
	};
	
// -----------------------------------------------------------------------------------------
// Redirection Table
:: RedirectionTable
	:== {#.RedirectionInfo};
	
:: RedirectionInfo = {
		ri_module_names			:: !.BitSet
	,	ri_constructor_infos	:: .{#ConstructorInfo}
	,	ri_s_constructor_infos	:: !Int
	};
	
default_redirection_info :: .RedirectionInfo;
default_redirection_info = {
		ri_module_names			= NewBitSet 0
	,	ri_constructor_infos	= {}
	,	ri_s_constructor_infos	= 0
	};

:: ConstructorInfo = {
		ci_name					:: !String
//	,	ci_prefixes				:: //!.{#LabelPrefixes}
	,	ci_prefix_set			:: !PrefixSet
	};
	
default_constructor_info :: !.ConstructorInfo;
default_constructor_info = {
		ci_name					= ""
	,	ci_prefix_set			= NoPrefixSet
	};
	
:: PrefixSet =
		NonStrictRecord !NonStrictRecord
	|	StrictRecord !StrictRecord
	|	NonStrictConstructor !NonStrictConstructor
	|	StrictConstructor !StrictConstructor
	|	NoPrefixSet
	;	
	
:: NonStrictRecord = {
		nsr_r_prefix				:: Maybe !String
	};
	
:: StrictRecord = {
		sr_r_prefix					:: Maybe !String
	,	sr_t_prefix					:: Maybe !String
	,	sr_c_prefix					:: Maybe !String
	};
	
:: NonStrictConstructor = {
		nsc_d_prefix				:: Maybe !String
	};
	
default_non_strict_constructor :: !.NonStrictConstructor;
default_non_strict_constructor = {
		nsc_d_prefix	= Nothing
	};
	
:: StrictConstructor = {
		sc_k_prefix					:: Maybe !String
	,	sc_d_prefix					:: Maybe !String
	,	sc_n_prefix					:: Maybe !String
	,	sc_l_prefix					:: Maybe !String
	};
	
default_strict_constructor :: !.StrictConstructor;
default_strict_constructor = {
		sc_k_prefix		= Nothing
	,	sc_d_prefix		= Nothing
	,	sc_n_prefix		= Nothing
	,	sc_l_prefix		= Nothing
	};
	

get_prefix :: !Char !LabelName !*RedirectionState -> (Maybe !String,!*RedirectionState);
get_prefix prefix {ln_redirection_index,ln_constructor_index} rs
	# (ci_prefix_set,rs)
		= rs!rs_redirection_table.[ln_redirection_index].ri_constructor_infos.[ln_constructor_index].ci_prefix_set;
	# a_prefix
		= case ci_prefix_set of {
			NonStrictRecord {nsr_r_prefix}
				| prefix == 'r'
					-> nsr_r_prefix;
					
			StrictRecord {sr_r_prefix,sr_t_prefix,sr_c_prefix}
				| prefix == 'r'
					-> sr_r_prefix;
				| prefix == 't'
					-> sr_t_prefix;
				| prefix == 'c'
					-> sr_c_prefix;
			
			NonStrictConstructor {nsc_d_prefix}
				| prefix == 'd'
					-> nsc_d_prefix;
					
			StrictConstructor {sc_k_prefix,sc_d_prefix,sc_n_prefix,sc_l_prefix}
				| prefix == 'k'
					-> sc_k_prefix;
				| prefix == 'd'
					-> sc_d_prefix;
				| prefix == 'n'
					-> sc_n_prefix;
				| prefix == 'l'
					-> sc_l_prefix;		
		};
	= (a_prefix,rs);
	
put_prefix :: !Char !LabelName !*RedirectionState -> !*RedirectionState;
put_prefix prefix {ln_label_name,ln_redirection_index,ln_constructor_index} rs
	# (ci_prefix_set,rs)
		= rs!rs_redirection_table.[ln_redirection_index].ri_constructor_infos.[ln_constructor_index].ci_prefix_set;
	# ci_prefix_set
		= case ci_prefix_set of {
			NonStrictRecord non_strict_record
				| prefix == 'r'
					-> NonStrictRecord { non_strict_record & nsr_r_prefix = Just ln_label_name };
			StrictRecord strict_record
				| prefix == 'r'
					-> StrictRecord { strict_record & sr_r_prefix = Just ln_label_name };
				| prefix == 't'
					-> StrictRecord { strict_record & sr_t_prefix = Just ln_label_name };
				| prefix == 'c'
					-> StrictRecord { strict_record & sr_c_prefix = Just ln_label_name };
			
			NonStrictConstructor non_strict_constructor
				| prefix == 'd'
					-> NonStrictConstructor { non_strict_constructor & nsc_d_prefix = Just ln_label_name };
					
			StrictConstructor strict_constructor
				| prefix == 'k'
					-> StrictConstructor { strict_constructor & sc_k_prefix = Just ln_label_name };
				| prefix == 'd'
					-> StrictConstructor { strict_constructor & sc_d_prefix = Just ln_label_name };
				| prefix == 'n'
					-> StrictConstructor { strict_constructor & sc_n_prefix = Just ln_label_name };
				| prefix == 'l'
					-> StrictConstructor { strict_constructor & sc_l_prefix = Just ln_label_name }; 		
		}
	= { rs & rs_redirection_table.[ln_redirection_index].ri_constructor_infos.[ln_constructor_index].ci_prefix_set = ci_prefix_set };

/*			
:: LabelPrefixes = {
		lp_n_prefix	:: Maybe !String
	,	lp_d_prefix :: Maybe !String
	,	lp_k_prefix	:: Maybe !String
	,	lp_c_prefix	:: Maybe !String
	,	lp_t_prefix	:: Maybe !String
	,	lp_r_prefix	:: Maybe !String
	,	lp_l_prefix	:: Maybe !String
	};

default_label_prefixes :: .LabelPrefixes;	
default_label_prefixes = {
		lp_n_prefix	= Nothing
	,	lp_d_prefix = Nothing
	,	lp_k_prefix	= Nothing
	,	lp_c_prefix	= Nothing
	,	lp_t_prefix	= Nothing
	,	lp_r_prefix	= Nothing
	,	lp_l_prefix	= Nothing
	};
*/

// -----------------------------------------------------------------------------------------
// Redirection State
/*
:: *RedirectionState = {
		rs_label_name_table		:: !*LabelNameTable
	,	rs_module_name_table	:: !ModuleNameTable
	,	rs_redirection_table	:: !RedirectionTable
	};
*/
import NamesTable;

// -----------------------------------------------------------------------------------------
// Redirection State
:: *RedirectionState = {
		rs_use_redirections		:: !Bool
	,	rs_label_name_table		:: !*LabelNameTable
	,	rs_module_name_table	:: !ModuleNameTable
	,	rs_redirection_table	:: !*RedirectionTable
	,	rs_messages				:: [String]					// string are in reverse order
	
	// new .. (used to redirect rts labels to the rts labels of the main library)
	,	rs_main_names_table		:: !*NamesTable
	,	rs_rts_modules			:: [String]
	,	rs_change_rts_label		:: !Bool
	// ... new 

	,	rs_symbol_names_a		:: !*{#{#Char}}

	};
		
default_redirection_state :: !*RedirectionState;
default_redirection_state 
	= { RedirectionState |
		rs_use_redirections		= False
	,	rs_label_name_table		= {}
	,	rs_module_name_table	= default_module_name_table
	,	rs_redirection_table	= {}
	,	rs_messages				= []
	
	// new ..
	,	rs_main_names_table		= {}
	,	rs_rts_modules			= []
	,	rs_change_rts_label		= False
	// ... new 

	,	rs_symbol_names_a		= {}

	};
	
class GetPutRedirectionState s 
where {
	get_redirection_state :: !*s -> (!*RedirectionState,!*s);
	put_redirection_state :: !*RedirectionState !*s -> !*s
};


// -----------------------------------------------------------------------------------------