check.icl

implementation module check

import StdEnv

import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef
import explicitimports, comparedefimp, checkFunctionBodies, containers, portToNewSyntax, compilerSwitches
import genericsupport
// import RWSDebug

cUndef :== (-1)
cDummyArray :== {}

isMainModule :: ModuleKind -> Bool
isMainModule MK_Main	= True
isMainModule _ 			= False

// AA: new implementation of generics ...
checkGenericDefs :: !Index !(Optional (CopiedDefinitions, Int)) !*{#GenericDef} !*{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*Heaps !*CheckState
	-> (!*{#GenericDef}, !*{#CheckedTypeDef}, !*{#ClassDef}, !*{#DclModule}, !*Heaps, !*CheckState)
checkGenericDefs mod_index opt_icl_info gen_defs type_defs class_defs modules heaps cs 	
	= check_generics 0 mod_index opt_icl_info gen_defs type_defs class_defs modules heaps cs
where
	check_generics index mod_index opt_icl_info gen_defs type_defs class_defs modules heaps cs
		# (n_generics, gen_defs) = usize gen_defs
		| index == n_generics 
			= (gen_defs, type_defs, class_defs, modules, heaps, cs)
			# (gen_defs, type_defs, class_defs, modules, heaps, cs) 
				= check_generic_def index mod_index opt_icl_info gen_defs type_defs class_defs modules heaps cs
			= check_generics (inc index) mod_index opt_icl_info gen_defs type_defs class_defs modules heaps cs		

	check_generic_def index mod_index opt_icl_info gen_defs type_defs class_defs modules heaps cs
		| has_to_be_checked mod_index index opt_icl_info 	
			= check_generic index mod_index gen_defs type_defs class_defs modules heaps cs		
				//---> ("check_generic", mod_index, index)
			= (gen_defs, type_defs, class_defs, modules, heaps, cs)
				//---> ("skipped check_generic", mod_index, index)

	has_to_be_checked module_index generic_index No 
		= True
	has_to_be_checked module_index generic_index (Yes ({copied_generic_defs}, n_cached_dcl_mods))
		= not (module_index < n_cached_dcl_mods && generic_index < size copied_generic_defs && copied_generic_defs.[generic_index])
			
	check_generic index mod_index gen_defs type_defs class_defs modules heaps cs		

		#(gen_def=:{gen_name, gen_pos}, gen_defs) = gen_defs ! [index]
		# cs = pushErrorAdmin (newPosition gen_name gen_pos) cs

		# (gen_def, heaps) = alloc_gen_info gen_def heaps

		# (gen_def, type_defs, class_defs, modules, heaps, cs)
			= check_generic_type gen_def mod_index type_defs class_defs modules heaps cs

		//# (heaps, cs) = check_generic_vars gen_def heaps cs

		# gen_defs = {gen_defs & [index] = gen_def} 
		# cs = popErrorAdmin cs	
		= (gen_defs, type_defs, class_defs, modules, heaps, cs)
				//---> ("check_generic", gen_name, gen_def.gen_vars, gen_def.gen_type)

	alloc_gen_info gen_def heaps=:{hp_generic_heap}
		# initial_info = 
			{ gen_classes = createArray 32 []
			, gen_cases = []
			, gen_var_kinds = []
			, gen_star_case = {gi_module=NoIndex, gi_index=NoIndex}
			}
		# (gen_info_ptr, hp_generic_heap) = newPtr initial_info hp_generic_heap 
		= (	{gen_def & gen_info_ptr = gen_info_ptr}, 
			{heaps & hp_generic_heap = hp_generic_heap})

	check_generic_vars {gen_vars,gen_type} heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}} cs	
		#! types = [gen_type.st_result:gen_type.st_args]
		#! th_vars = performOnTypeVars mark_var types th_vars
		#! (th_vars,cs) = foldSt check_var_marked gen_vars (th_vars,cs)
		#! th_vars = performOnTypeVars initializeToTVI_Empty types th_vars
		= ({heaps & hp_type_heaps={hp_type_heaps&th_vars=th_vars}}, cs)
	where
		mark_var _ {tv_name,tv_info_ptr} th_vars
			= writePtr tv_info_ptr TVI_Used th_vars
		check_var_marked {tv_name,tv_info_ptr} (th_vars,cs=:{cs_error})
			#! (tv_info, th_vars) = readPtr tv_info_ptr th_vars
			#! cs_error = case tv_info of  
				TVI_Empty -> checkError tv_name "generic variable not used" cs_error
				TVI_Used -> cs_error
			= (th_vars, {cs & cs_error = cs_error})	

	check_generic_type gen_def=:{gen_type, gen_vars, gen_name, gen_pos} module_index type_defs class_defs modules heaps=:{hp_type_heaps} cs

		#! (checked_gen_type, _, type_defs, class_defs, modules, hp_type_heaps, cs) =
			checkFunctionType module_index gen_type SP_None type_defs class_defs modules hp_type_heaps cs
		
		#! (checked_gen_vars, cs) = check_generic_vars gen_vars checked_gen_type.st_vars cs		
		#! checked_gen_type = { checked_gen_type & st_vars = move_gen_vars checked_gen_vars checked_gen_type.st_vars}
				
		#! (hp_type_heaps, cs) = check_no_generic_vars_in_contexts checked_gen_type checked_gen_vars hp_type_heaps cs
		= 	( {gen_def & gen_type = checked_gen_type, gen_vars = checked_gen_vars}
			, type_defs
			, class_defs
			, modules
			, {heaps & hp_type_heaps = hp_type_heaps}
			, cs
			)
			//---> ("check_genric_type", gen_vars, checked_gen_vars, checked_gen_type)
	where
		check_generic_vars gen_vars st_vars cs=:{cs_error}
			# (gen_vars, _, cs_error) = foldSt check_generic_var gen_vars ([], st_vars, cs_error)
			= (reverse gen_vars, {cs & cs_error = cs_error})
	
		// make sure generic variables are first
		move_gen_vars gen_vars st_vars
			= gen_vars ++ (removeMembers st_vars gen_vars)
				
		check_generic_var gv (acc_gvs, [], error)
			= (acc_gvs, [], checkError gv.tv_name "generic variable not used" error) 
		check_generic_var gv (acc_gvs, [tv:tvs], error)
			| gv.tv_name.id_name == tv.tv_name.id_name
				= ([tv:acc_gvs], tvs, error)
				# (acc_gvs, tvs, error) = check_generic_var gv (acc_gvs, tvs, error)
				= (acc_gvs, [tv:tvs], error)
									
	// returns reversed variable list		
	add_vars_to_symbol_table gen_vars type_heaps=:{th_vars} cs=:{cs_error, cs_symbol_table}
		#! (rev_gen_vars,cs_symbol_table,th_vars, cs_error) 
			= foldSt add_var_to_symbol_table gen_vars ([],cs.cs_symbol_table,th_vars, cs_error)
		= (	rev_gen_vars,
			{type_heaps & th_vars = th_vars}, 
			{cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table})			
	
	add_var_to_symbol_table :: !TypeVar !(![TypeVar], !*SymbolTable, !*TypeVarHeap, !*ErrorAdmin)
		-> (![TypeVar],!*SymbolTable,!*TypeVarHeap,!*ErrorAdmin)
	add_var_to_symbol_table tv=:{tv_name={id_name,id_info}} (rev_class_args, symbol_table, th_vars, error)
	  	#! (entry, symbol_table) = readPtr id_info symbol_table
		| entry.ste_kind == STE_Empty || entry.ste_def_level < cGlobalScope
			# (new_var_ptr, th_vars) = newPtr TVI_Empty th_vars
			# symbol_table = NewEntry symbol_table id_info (STE_TypeVariable new_var_ptr) NoIndex cGlobalScope entry
			= ([{ tv & tv_info_ptr = new_var_ptr} : rev_class_args], symbol_table, th_vars, error)
			= (rev_class_args, symbol_table, th_vars, checkError id_name "generic variable already defined" error)
	
	// also reverses variable list (but does not make coffe)
	remove_vars_from_symbol_table rev_gen_vars cs=:{cs_symbol_table}
		#! (gen_vars, cs_symbol_table) = foldSt remove_var_from_symbol_table rev_gen_vars ([], cs_symbol_table)
		= (gen_vars, { cs & cs_symbol_table = cs_symbol_table})
	remove_var_from_symbol_table tv=:{tv_name={id_name,id_info}} (gen_vars, symbol_table)
	  	#! (entry, symbol_table) = readPtr id_info symbol_table
		#! symbol_table = writePtr id_info entry.ste_previous symbol_table
		=([tv:gen_vars], symbol_table)

	check_no_generic_vars_in_contexts :: !SymbolType ![TypeVar] !*TypeHeaps !*CheckState
		-> (!*TypeHeaps, !*CheckState)
	check_no_generic_vars_in_contexts gen_type gen_vars th=:{th_vars} cs=:{cs_error}
	
		#! th_vars = clear_type_vars gen_type.st_vars th_vars
		#! th_vars = mark_type_vars_used gen_vars th_vars
		#! (th_vars, cs_error) = check_type_vars_not_used gen_type.st_context th_vars cs_error
		#! th_vars = clear_type_vars gen_type.st_vars th_vars
	
		= ({th & th_vars = th_vars}, {cs & cs_error = cs_error})
	where
		mark_type_vars_used gen_vars th_vars
			= foldSt (write_type_var_info TVI_Used) gen_vars th_vars
		clear_type_vars gen_vars th_vars
			= foldSt (write_type_var_info TVI_Empty) gen_vars th_vars
		write_type_var_info tvi {tv_name, tv_info_ptr} th_vars 
			= writePtr tv_info_ptr tvi th_vars
		
		check_type_vars_not_used :: ![TypeContext] !*TypeVarHeap !*ErrorAdmin -> (!*TypeVarHeap, !*ErrorAdmin) 
		check_type_vars_not_used contexts th_vars cs_error
			# types	= flatten [tc_types \\ {tc_types} <- contexts]		
			# atypes = [{at_type=t,at_attribute=TA_None} \\ t <- types]
			= performOnTypeVars check_type_var_not_used atypes (th_vars, cs_error)
		check_type_var_not_used attr tv=:{tv_name, tv_info_ptr} (th_vars, cs_error)
			#! (tv_info, th_vars) = readPtr tv_info_ptr th_vars
			= case tv_info of
				TVI_Empty  
					-> (th_vars, cs_error)
				TVI_Used
					#! cs_error = checkError tv_name "context restrictions on generic variables are not allowed" cs_error 
					-> (th_vars, cs_error)
				_	-> abort ("check_no_generic_vars_in_contexts: wrong TVI" ---> (tv, tv_info))	
							
checkGenericCaseDefs :: !Index !*{#GenericCaseDef} !*{#GenericDef} !u:{#CheckedTypeDef} !*{#DclModule} !*Heaps !*CheckState
	-> (!*{#GenericCaseDef}, !*{#GenericDef}, !u:{#CheckedTypeDef}, !*{#DclModule},!.Heaps,!.CheckState)
checkGenericCaseDefs mod_index gen_case_defs generic_defs type_defs modules heaps cs
	= check_instances 0 mod_index gen_case_defs generic_defs type_defs modules heaps cs
where
	check_instances index mod_index gen_case_defs generic_defs type_defs modules heaps cs
		# (n_gc, gen_inst_defs) = usize gen_case_defs
		| index == n_gc  
			= (gen_case_defs, generic_defs, type_defs, modules, heaps, cs)	
			# (gen_case_defs, generic_defs, type_defs, modules, heaps, cs) 
				= check_instance index mod_index gen_case_defs generic_defs type_defs modules heaps cs
			= check_instances (inc index)  mod_index gen_case_defs generic_defs type_defs modules heaps cs			

	check_instance index mod_index gen_case_defs generic_defs type_defs modules heaps cs

		#! (case_def=:{gc_name,gc_gname,gc_pos,gc_type}, gen_case_defs) = gen_case_defs ! [index]

		#! cs = pushErrorAdmin (newPosition gc_name gc_pos) cs

		#! (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
		 	= check_instance_type mod_index gc_type type_defs modules heaps cs 

		#! (generic_gi, cs) = get_generic_index gc_gname mod_index cs 
		| not cs.cs_error.ea_ok
			# cs = popErrorAdmin cs
			= (gen_case_defs, generic_defs, type_defs, modules, heaps, cs)
				 
		#! case_def = 
			{ case_def 
			& gc_generic = generic_gi
			, gc_type = gc_type
			, gc_type_cons = gc_type_cons
			}
		#! gen_case_defs = { gen_case_defs & [index] = case_def }
				
		#! (generic_def, generic_defs, modules) = get_generic_def generic_gi mod_index generic_defs modules
		#! gindex = {gi_module=mod_index,gi_index=index}
		#! heaps = add_case_to_generic generic_def gindex heaps 		
	
		#! (heaps, cs) = check_star_case gc_type_cons generic_def gindex heaps cs 
			
		#! cs = popErrorAdmin cs	
		= (gen_case_defs, generic_defs, type_defs, modules, heaps, cs)
			//---> ("check_generic_case", gc_name, gc_type_cons)

	check_instance_type module_index (TA type_cons []) type_defs modules heaps=:{hp_type_heaps} cs 

		# (entry, cs_symbol_table) = readPtr type_cons.type_name.id_info cs.cs_symbol_table
		# cs = {cs & cs_symbol_table = cs_symbol_table}
	  	# (type_index, type_module) = retrieveGlobalDefinition entry STE_Type module_index
		| type_index == NotFound
			# cs_error = checkError type_cons.type_name "generic argument type undefined" cs.cs_error
 			= (TA type_cons [], TypeConsSymb type_cons, type_defs, modules,{heaps&hp_type_heaps = hp_type_heaps}, {cs&cs_error=cs_error})
		# (type_def, type_defs, modules) 
			= getTypeDef module_index {glob_module=type_module, glob_object=type_index} type_defs modules		
		# type_cons = { type_cons & type_index = { glob_object = type_index, glob_module = type_module }}
		= (TA type_cons [], TypeConsSymb type_cons, type_defs, modules,{heaps&hp_type_heaps = hp_type_heaps}, cs)
	check_instance_type module_index (TB b) type_defs modules heaps cs
		= (TB b, TypeConsBasic b, type_defs, modules,heaps, cs) 
	check_instance_type module_index TArrow type_defs modules heaps cs
		= (TArrow, TypeConsArrow, type_defs, modules, heaps , cs) 		
// General instance ..
	check_instance_type module_index (TV tv) type_defs modules heaps=:{hp_type_heaps} cs
		# (tv_info_ptr, th_vars) = newPtr TVI_Empty hp_type_heaps.th_vars
		# tv = {tv & tv_info_ptr = tv_info_ptr}		
		= 	( TV tv, TypeConsVar tv, type_defs, modules
			, {heaps& hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}, cs) 
	
// .. General instance
	check_instance_type module_index ins_type type_defs modules heaps cs=:{cs_error}
		# cs_error = checkError {id_name="<>",id_info=nilPtr} "invalid generic type argument" cs_error
		= (ins_type, TypeConsArrow, type_defs, modules, heaps, {cs & cs_error=cs_error})

	get_generic_index :: !Ident !Index !*CheckState -> (!GlobalIndex, !*CheckState)
	get_generic_index {id_name,id_info} mod_index cs=:{cs_symbol_table}
 		# (ste, cs_symbol_table) = readPtr id_info cs_symbol_table
 		# cs = {cs & cs_symbol_table = cs_symbol_table}
 		= case ste.ste_kind of
			STE_Generic
				-> ({gi_module=mod_index,gi_index = ste.ste_index}, cs) 
			STE_Imported STE_Generic imported_generic_module
				-> ({gi_module=imported_generic_module,gi_index = ste.ste_index}, cs)
			_	->	//abort "--------------" ---> ("STE_Kind", ste.ste_kind)			
					( {gi_module=NoIndex,gi_index = NoIndex}
					, {cs & cs_error = checkError id_name "generic undefined" cs.cs_error})

	get_generic_def :: !GlobalIndex !Int !u:{#GenericDef} !v:{#DclModule} -> (!GenericDef,!u:{#GenericDef},!v:{#DclModule})
	get_generic_def {gi_module, gi_index} mod_index generic_defs modules
		| gi_module == mod_index
			# (generic_def, generic_defs) = generic_defs![gi_index]
			= (generic_def, generic_defs, modules)
			# (dcl_mod, modules) = modules![gi_module]
			= (dcl_mod.dcl_common.com_generic_defs.[gi_index], generic_defs, modules)

	add_case_to_generic :: !GenericDef !GlobalIndex !*Heaps -> !*Heaps
	add_case_to_generic {gen_info_ptr} index heaps=:{hp_generic_heap} 
		# (info=:{gen_cases}, hp_generic_heap) = readPtr gen_info_ptr hp_generic_heap
		# info = { info & gen_cases = [index:gen_cases]}
		= { heaps & hp_generic_heap = writePtr gen_info_ptr info hp_generic_heap} 
								
	check_star_case :: !TypeCons !GenericDef !GlobalIndex !*Heaps !*CheckState -> (!*Heaps, !*CheckState)
	check_star_case (TypeConsVar _) {gen_name, gen_info_ptr} index heaps=:{hp_generic_heap} cs=:{cs_error} 
		# (info=:{gen_star_case}, hp_generic_heap) = readPtr gen_info_ptr hp_generic_heap
		| gen_star_case.gi_module <> NoIndex
			# cs_error = checkError gen_name "general kind-* case is already defined" cs_error 
			= ({ heaps & hp_generic_heap = hp_generic_heap}, {cs & cs_error = cs_error})   
			# info = { info & gen_star_case = index }
			# hp_generic_heap = writePtr gen_info_ptr info hp_generic_heap	
			= ({ heaps & hp_generic_heap = hp_generic_heap}, {cs & cs_error = cs_error}) 
	check_star_case _ _ _ heaps cs 
		= (heaps, cs)
				
								
// ... AA: new implementation of generics

				
checkTypeClasses :: !Index !(Optional (CopiedDefinitions, Int)) !*{#ClassDef} !*{#MemberDef} !*{#CheckedTypeDef} !*{#DclModule} !*Heaps !*CheckState
	-> (!*{#ClassDef}, !*{#MemberDef}, !*{#CheckedTypeDef}, !*{#DclModule}, !*Heaps, !*CheckState)
checkTypeClasses module_index opt_icl_info class_defs member_defs type_defs modules heaps=:{hp_type_heaps} cs
	#! n_classes = size class_defs
	# (class_defs,member_defs,type_defs,modules,hp_type_heaps,cs) 
		= iFoldSt (check_type_class module_index opt_icl_info) 0 n_classes (class_defs, member_defs, type_defs, modules, hp_type_heaps, cs)
	= (class_defs,member_defs,type_defs,modules,{heaps & hp_type_heaps = hp_type_heaps},cs)
where
	check_type_class module_index opt_icl_info class_index (class_defs, member_defs, type_defs, modules, type_heaps, cs=:{cs_symbol_table,cs_error})
		| has_to_be_checked module_index opt_icl_info class_index
			# (class_def=:{class_name,class_pos,class_args,class_context,class_members}, class_defs) = class_defs![class_index]
			  cs = {cs & cs_error = setErrorAdmin (newPosition class_name class_pos) cs_error }
			  (class_args, class_context, type_defs, class_defs, modules, type_heaps, cs)
			  		= checkSuperClasses class_args class_context module_index type_defs class_defs modules type_heaps cs
			  class_defs = { class_defs & [class_index] = { class_def & class_context = class_context, class_args = class_args }}
			  member_defs = set_classes_in_member_defs 0 class_members {glob_object = class_index, glob_module = module_index} member_defs 
			= (class_defs, member_defs, type_defs, modules, type_heaps, cs)
			= (class_defs, member_defs, type_defs, modules, type_heaps, cs)

	has_to_be_checked module_index No class_index
		= True
	has_to_be_checked module_index (Yes ({copied_class_defs}, n_cached_dcl_mods)) class_index
		= not (module_index < n_cached_dcl_mods && class_index < size copied_class_defs && copied_class_defs.[class_index])

	set_classes_in_member_defs mem_offset class_members glob_class_index member_defs
		| mem_offset == size class_members
			= member_defs
			# {ds_index} = class_members.[mem_offset]
			# (member_def, member_defs) = member_defs![ds_index]
			= set_classes_in_member_defs (inc mem_offset) class_members glob_class_index { member_defs & [ds_index] = { member_def & me_class = glob_class_index }}

checkSpecial :: !Index !FunType !Index !SpecialSubstitution !(!Index, ![FunType], !*Heaps,!*PredefinedSymbols,!*ErrorAdmin)
	-> (!Special, !(!Index, ![FunType], !*Heaps,!*PredefinedSymbols, !*ErrorAdmin))
checkSpecial mod_index fun_type=:{ft_type} fun_index subst (next_inst_index, special_types, heaps, predef_symbols,error)
	# (special_type, hp_type_heaps, error) = substitute_type ft_type subst heaps.hp_type_heaps error
	  (spec_types, predef_symbols, error) = checkAndCollectTypesOfContextsOfSpecials special_type.st_context predef_symbols error
	  ft_type = { special_type & st_context = [] }
	  (new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap
	= ( { spec_index = { glob_module = mod_index, glob_object = next_inst_index }, spec_types = spec_types, spec_vars = subst.ss_vars, spec_attrs = subst.ss_attrs },
			((inc next_inst_index), [{ fun_type & ft_type = ft_type, ft_specials = SP_FunIndex fun_index, ft_type_ptr = new_info_ptr} : special_types ],
					{ heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap }, predef_symbols, error))
where	
	substitute_type st=:{st_vars,st_attr_vars,st_args,st_result,st_context,st_attr_env} environment type_heaps error
		# (st_vars, st_attr_vars, [st_result : st_args], st_context, st_attr_env, _, type_heaps, error)
			= instantiateTypes st_vars st_attr_vars [ st_result : st_args ] st_context st_attr_env environment [] type_heaps error
		= ({st & st_vars = st_vars, st_args = st_args, st_result = st_result, st_attr_vars = st_attr_vars,
			st_context = st_context, st_attr_env = st_attr_env }, type_heaps, error)

checkDclFunctions :: !Index !Index ![FunType] !v:{#CheckedTypeDef} !x:{#ClassDef} !v:{#.DclModule} !*Heaps !*CheckState
	-> (!Index, ![FunType], ![FunType], !v:{#CheckedTypeDef}, !x:{#ClassDef}, !v:{#DclModule}, !*Heaps, !*CheckState)
checkDclFunctions module_index first_inst_index fun_types type_defs class_defs modules heaps cs
	= check_dcl_functions module_index fun_types 0 first_inst_index [] [] type_defs class_defs modules heaps cs
where
	check_dcl_functions ::  !Index ![FunType]   !Index  !Index ![FunType] ![FunType] !v:{#CheckedTypeDef} !x:{#ClassDef} !v:{#DclModule} !*Heaps !*CheckState
		 -> (!Index, ![FunType], ![FunType],!v:{#CheckedTypeDef}, !x:{#ClassDef}, !v:{#DclModule}, !*Heaps, !*CheckState)
	check_dcl_functions module_index [] fun_index next_inst_index collected_funtypes collected_instances type_defs class_defs modules heaps cs
		= (next_inst_index, collected_funtypes, collected_instances, type_defs, class_defs, modules, heaps, cs)
	check_dcl_functions module_index [fun_type=:{ft_symb,ft_type,ft_pos,ft_specials} : fun_types] fun_index
			next_inst_index collected_funtypes collected_instances type_defs class_defs modules heaps cs
		# position = newPosition ft_symb ft_pos
		  cs = { cs & cs_error = setErrorAdmin position cs.cs_error }
		  (ft_type, ft_specials, type_defs,  class_defs, modules, hp_type_heaps, cs)
		  		= checkFunctionType module_index ft_type ft_specials type_defs class_defs modules heaps.hp_type_heaps cs
		  (spec_types, next_inst_index, collected_instances, heaps, cs_predef_symbols,cs_error)
		  		= check_specials module_index { fun_type & ft_type = ft_type } fun_index ft_specials next_inst_index collected_instances
		  				{ heaps & hp_type_heaps = hp_type_heaps } cs.cs_predef_symbols cs.cs_error
		  (new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap
		= check_dcl_functions module_index fun_types (inc fun_index) next_inst_index [
				{ fun_type & ft_type = ft_type, ft_specials = spec_types, ft_type_ptr = new_info_ptr } : collected_funtypes]
					collected_instances type_defs class_defs modules { heaps & hp_var_heap = hp_var_heap } { cs & cs_predef_symbols=cs_predef_symbols,cs_error = cs_error }

	check_specials :: !Index !FunType !Index !Specials !Index ![FunType] !*Heaps !*PredefinedSymbols !*ErrorAdmin
		-> (!Specials, !Index, ![FunType], !*Heaps, !*PredefinedSymbols, !*ErrorAdmin)
	check_specials mod_index fun_type fun_index (SP_Substitutions substs) next_inst_index all_instances heaps predef_symbols error
		# (list_of_specials, (next_inst_index, all_instances, heaps, cs_predef_symbols,cs_error))
				= mapSt (checkSpecial mod_index fun_type fun_index) substs (next_inst_index, all_instances, heaps, predef_symbols,error)
		= (SP_ContextTypes list_of_specials, next_inst_index, all_instances, heaps, cs_predef_symbols,cs_error)

	check_specials mod_index fun_type fun_index SP_None next_inst_index all_instances heaps predef_symbols error
		= (SP_None, next_inst_index, all_instances, heaps, predef_symbols,error)

checkSpecialsOfInstances :: !Index !Index ![ClassInstance] !Index ![ClassInstance] ![FunType] {# FunType} *{! [Special] } !*Heaps !*PredefinedSymbols !*ErrorAdmin
		-> (!Index, ![ClassInstance], ![FunType], !*{! [Special]}, !*Heaps, !*PredefinedSymbols,!*ErrorAdmin)
checkSpecialsOfInstances mod_index first_mem_index [class_inst=:{ins_members,ins_specials} : class_insts] next_inst_index all_class_instances all_specials
		new_inst_defs all_spec_types heaps predef_symbols error
	= case ins_specials of
		SP_TypeOffset type_offset
			# (next_inst_index, rev_mem_specials, all_specials, all_spec_types, heaps,predef_symbols, error)
				= check_and_build_members mod_index first_mem_index 0 ins_members type_offset next_inst_index [] all_specials new_inst_defs all_spec_types heaps predef_symbols error
			  class_inst = { class_inst & ins_members = { mem \\ mem <- reverse rev_mem_specials } }
			-> checkSpecialsOfInstances mod_index first_mem_index class_insts next_inst_index [class_inst : all_class_instances]
					all_specials new_inst_defs all_spec_types heaps predef_symbols error
		SP_None
			-> checkSpecialsOfInstances mod_index first_mem_index class_insts next_inst_index [class_inst : all_class_instances]
					all_specials new_inst_defs all_spec_types heaps predef_symbols error
where
	check_and_build_members :: !Index !Index !Int {# DefinedSymbol} !Int !Index ![DefinedSymbol] ![FunType] !{#FunType} !*{! [Special]} !*Heaps !*PredefinedSymbols !*ErrorAdmin
		-> (!Index, ![DefinedSymbol], ![FunType], !*{! [Special]}, !*Heaps, !*PredefinedSymbols,!*ErrorAdmin)
	check_and_build_members mod_index first_mem_index member_offset ins_members type_offset next_inst_index rev_mem_specials all_specials inst_spec_defs
			all_spec_types heaps predef_symbols error
		| member_offset < size ins_members
			# member = ins_members.[member_offset]
			  member_index = member.ds_index
			  spec_member_index = member_index - first_mem_index
		 	# (spec_types, all_spec_types) = all_spec_types![spec_member_index]
		 	# mem_inst = inst_spec_defs.[spec_member_index]
		 	  (SP_Substitutions specials) = mem_inst.ft_specials
		 	  env = specials !! type_offset
			  member = { member & ds_index = next_inst_index }
			  (spec_type, (next_inst_index, all_specials, heaps, predef_symbols,error))
			  		= checkSpecial mod_index mem_inst member_index env (next_inst_index, all_specials, heaps, predef_symbols,error)
			  all_spec_types = { all_spec_types & [spec_member_index] = [ spec_type : spec_types] }
			= check_and_build_members mod_index first_mem_index (inc member_offset) ins_members type_offset next_inst_index [ member : rev_mem_specials ]
					all_specials inst_spec_defs all_spec_types heaps predef_symbols error
			= (next_inst_index, rev_mem_specials, all_specials, all_spec_types, heaps, predef_symbols,error)
checkSpecialsOfInstances mod_index first_mem_index [] next_inst_index all_class_instances all_specials inst_spec_defs all_spec_types heaps predef_symbols error
	= (next_inst_index, all_class_instances, all_specials, all_spec_types, heaps, predef_symbols,error)

checkMemberTypes :: !Index !(Optional (CopiedDefinitions, Int)) !*{#MemberDef} !*{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*Heaps !*CheckState
	-> (!*{#MemberDef}, !*{#CheckedTypeDef}, !*{#ClassDef}, !*{#DclModule}, !*Heaps, !*CheckState)
checkMemberTypes module_index opt_icl_info member_defs type_defs class_defs modules heaps=:{hp_type_heaps,hp_var_heap} cs
	#! nr_of_members = size member_defs
	# (mds,tds,cds,modules,hp_type_heaps,hp_var_heap,cs) 
		= iFoldSt (check_class_member module_index opt_icl_info) 0 nr_of_members (member_defs, type_defs, class_defs, modules, hp_type_heaps, hp_var_heap, cs)
	= (mds,tds,cds,modules,{heaps & hp_type_heaps = hp_type_heaps,hp_var_heap = hp_var_heap},cs) 
where
	check_class_member module_index opt_icl_info member_index (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs)
		# (member_def=:{me_symb,me_type,me_pos,me_class}, member_defs) = member_defs![member_index]
		| has_to_be_checked opt_icl_info me_class
			# position = newPosition me_symb me_pos
			  cs = { cs & cs_error = setErrorAdmin position cs.cs_error }
			  (me_type, type_defs, class_defs, modules, type_heaps, cs)
			   		= checkMemberType module_index me_type type_defs class_defs modules type_heaps cs
			  me_class_vars = [ type_var \\ (TV type_var) <- (hd me_type.st_context).tc_types ]
			  (me_type_ptr, var_heap) = newPtr VI_Empty var_heap		   
			= ({ member_defs & [member_index] = { member_def & me_type = me_type, me_class_vars = me_class_vars, me_type_ptr = me_type_ptr }},
					type_defs, class_defs, modules, type_heaps, var_heap, cs)
			= (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs)

	has_to_be_checked No glob_class_index
		= True
	has_to_be_checked (Yes ({copied_class_defs}, n_cached_dcl_mods)) {glob_module,glob_object}
		= not (glob_module < n_cached_dcl_mods && glob_object < size copied_class_defs && copied_class_defs.[glob_object])

::	InstanceSymbols =
	{	is_type_defs		:: !.{# CheckedTypeDef}
	,	is_class_defs		:: !.{# ClassDef}
	,	is_member_defs		:: !.{# MemberDef}
	,	is_modules			:: !.{# DclModule}
	}

// AA..
checkInstanceDefs :: !Index !*{#ClassInstance} !u:{#CheckedTypeDef} !u:{#ClassDef} !u:{#MemberDef} !u:{#DclModule} !*Heaps !*CheckState
	-> (!.{#ClassInstance},!u:{#CheckedTypeDef},!u:{#ClassDef},!u:{#MemberDef}, !u:{#DclModule},!.Heaps,!.CheckState)
checkInstanceDefs mod_index instance_defs type_defs class_defs member_defs modules heaps=:{hp_type_heaps} cs
	# is = { is_type_defs = type_defs, is_class_defs = class_defs, is_member_defs = member_defs, is_modules = modules }
	  (instance_defs, is, hp_type_heaps, cs) = check_instance_defs 0 mod_index instance_defs is hp_type_heaps cs
	= (instance_defs, is.is_type_defs, is.is_class_defs, is.is_member_defs, is.is_modules, {heaps & hp_type_heaps = hp_type_heaps}, cs)
where
	check_instance_defs :: !Index !Index !*{# ClassInstance} !u:InstanceSymbols !*TypeHeaps !*CheckState
		-> (!*{# ClassInstance},!u:InstanceSymbols,!*TypeHeaps,!*CheckState)
	check_instance_defs inst_index mod_index instance_defs is type_heaps cs
		| inst_index < size instance_defs
			# (instance_def, instance_defs) = instance_defs![inst_index]
			  (instance_def, is, type_heaps, cs) = check_instance mod_index instance_def is type_heaps cs
			= check_instance_defs (inc inst_index) mod_index { instance_defs & [inst_index] = instance_def } is type_heaps cs
			= (instance_defs, is, type_heaps, cs)

	check_instance :: !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
	check_instance module_index
			ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident}
			is=:{is_class_defs,is_modules} type_heaps cs=:{cs_symbol_table}
		#  	(entry, cs_symbol_table) = readPtr id_info cs_symbol_table
		# 	cs = pushErrorAdmin (newPosition ins_ident ins_pos) { cs & cs_symbol_table = cs_symbol_table }
		#   (ins, is, type_heaps, cs) = case entry.ste_kind of
				STE_Class				
					# (class_def, is) = class_by_index entry.ste_index is
					-> check_class_instance	class_def module_index entry.ste_index module_index ins is type_heaps cs 
				STE_Imported STE_Class decl_index	
					# (class_def, is) = class_by_module_index decl_index entry.ste_index is
					-> check_class_instance class_def module_index entry.ste_index decl_index ins is type_heaps cs
				ste -> (ins, is, type_heaps, { cs & cs_error = checkError id_name "class undefined" cs.cs_error })
		= (ins, is, type_heaps, popErrorAdmin cs)

	where
			class_by_index class_index is=:{is_class_defs}
				#	(class_def, is_class_defs) = is_class_defs![class_index]
 				= (class_def, {is & is_class_defs = is_class_defs})
			class_by_module_index decl_index class_index is=:{is_modules}
 				# 	(dcl_mod, is_modules) = is_modules![decl_index]
					class_def = dcl_mod.dcl_common.com_class_defs.[class_index]
				= (class_def, {is & is_modules = is_modules })

	check_class_instance :: ClassDef !Index !Index !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState 
		-> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
	check_class_instance class_def module_index class_index class_mod_index
			ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident}
			is=:{is_class_defs,is_modules} type_heaps cs=:{cs_symbol_table}	
		| class_def.class_arity == ds_arity
			# ins_class = { glob_object = { class_name & ds_index = class_index }, glob_module = class_mod_index}
			  (ins_type, ins_specials, is_type_defs, is_class_defs, is_modules, type_heaps, cs)
			  		= checkInstanceType module_index ins_class ins_type ins_specials
							is.is_type_defs is.is_class_defs is.is_modules type_heaps cs
			  is = { is & is_type_defs = is_type_defs, is_class_defs = is_class_defs, is_modules = is_modules }
			= ({ins & ins_class = ins_class, ins_type = ins_type, ins_specials = ins_specials}, is, type_heaps, cs)
		// otherwise
			= ( ins, is, type_heaps
			  , { cs & cs_error = checkError id_name ("wrong arity: expected "+++toString class_def.class_arity+++" found "+++toString ds_arity) cs.cs_error }
			  )

checkInstances :: !Index !*CommonDefs !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
	-> (![(Index,SymbolType)], !*CommonDefs, !u:{# DclModule}, !*VarHeap , !*TypeHeaps, !*CheckState)
checkInstances mod_index icl_common=:{com_instance_defs,com_class_defs,com_member_defs,com_generic_defs,com_type_defs} modules var_heap type_heaps cs=:{cs_error}
	| cs_error.ea_ok
		# (instance_types, com_instance_defs, com_class_defs, com_member_defs, com_generic_defs, com_type_defs, modules, var_heap, type_heaps, cs)
				= check_instances 0 mod_index [] com_instance_defs com_class_defs com_member_defs /*AA*/com_generic_defs com_type_defs modules var_heap type_heaps cs
		= (instance_types, { icl_common & com_instance_defs = com_instance_defs,com_class_defs = com_class_defs,com_member_defs = com_member_defs, /*AA*/com_generic_defs = com_generic_defs, com_type_defs = com_type_defs },
			 	modules, var_heap, type_heaps, cs)
		= ([], icl_common, modules, var_heap, type_heaps, cs)
where
	check_instances :: !Index !Index ![(Index,SymbolType)] !x:{# ClassInstance} !w:{# ClassDef} !v:{# MemberDef} /*AA*/!w:{# GenericDef} !nerd:{# CheckedTypeDef} !u:{# DclModule}
		!*VarHeap !*TypeHeaps !*CheckState
			-> (![(Index,SymbolType)], !x:{# ClassInstance}, !w:{# ClassDef}, !v:{# MemberDef}, /*AA*/!w:{# GenericDef}, !nerd:{# CheckedTypeDef}, !u:{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
	check_instances inst_index mod_index instance_types instance_defs class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs
		| inst_index < size instance_defs
			# (instance_def=:{ins_ident, ins_pos}, instance_defs) = instance_defs![inst_index]
			# (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) =
					check_class_instance instance_def mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs				 
			= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs 
		// otherwise
			= (instance_types, instance_defs, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)

	check_class_instance {ins_pos,ins_class,ins_members,ins_type} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs
			# ({class_members,class_name}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules
			  class_size = size class_members
			| class_size == size ins_members
				# (instance_types, member_defs, type_defs, modules, var_heap, type_heaps, cs) 
						= check_member_instances mod_index ins_class.glob_module
			  	        	 0 class_size ins_members class_members class_name ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps cs
				= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
			// otherwise
				# cs = { cs & cs_error = checkError class_name "different number of members specified" cs.cs_error }
				= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)

/*
	check_generic_instance {ins_class, ins_members, ins_generate} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs
			# ({gen_name, gen_member_name}, generic_defs, modules) = getGenericDef ins_class mod_index generic_defs modules		
			//| ins_generate 
			//	= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
			| size ins_members <> 1 				
				# cs = { cs & cs_error = checkError gen_name "generic instance must have one member" cs.cs_error }
				= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
			# member_name = ins_members.[0].ds_ident
			| member_name <> gen_member_name
				# cs = { cs & cs_error = checkError member_name "wrong member name" cs.cs_error }
				= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)				
			// otherwise
				= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
*/
	check_member_instances :: !Index !Index !Int !Int !{#DefinedSymbol} !{#DefinedSymbol} Ident !Position !InstanceType ![(Index,SymbolType)]
		!v:{# MemberDef} !blah:{# CheckedTypeDef} !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
			-> (![(Index,SymbolType)], !v:{# MemberDef}, !blah:{# CheckedTypeDef}, !u:{# DclModule},!*VarHeap, !*TypeHeaps, !*CheckState)

	check_member_instances module_index member_mod_index mem_offset class_size ins_members class_members
				class_name ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps cs=:{cs_x={x_main_dcl_module_n}}
		| mem_offset == class_size
			= (instance_types, member_defs, type_defs, modules, var_heap, type_heaps, cs)
			# ins_member = ins_members.[mem_offset]
			  class_member = class_members.[mem_offset]
			  cs = setErrorAdmin (newPosition class_name ins_pos) cs
			| ins_member.ds_ident <> class_member.ds_ident
				= check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type 
						instance_types member_defs type_defs modules var_heap type_heaps
							{ cs & cs_error = checkError class_member.ds_ident "instance of class member expected" cs.cs_error}
			| ins_member.ds_arity <> class_member.ds_arity
				= check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type
						instance_types member_defs type_defs modules var_heap type_heaps
							{ cs & cs_error = checkError class_member.ds_ident "used with wrong arity" cs.cs_error}
				# ({me_symb, me_type,me_class_vars,me_pos}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules
				  (instance_type, _, type_heaps, Yes (modules, type_defs), cs_error)
				  		= determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps (Yes (modules, type_defs, x_main_dcl_module_n)) cs.cs_error
				  (st_context, var_heap) = initializeContextVariables instance_type.st_context var_heap
				= check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type
						[ (ins_member.ds_index, { instance_type & st_context = st_context }) : instance_types ] member_defs type_defs modules var_heap type_heaps { cs & cs_error = cs_error }


getClassDef :: !(Global DefinedSymbol) !Int !u:{#ClassDef} !v:{#DclModule} -> (!ClassDef,!u:{#ClassDef},!v:{#DclModule})
getClassDef {glob_module, glob_object={ds_ident, ds_index}} mod_index class_defs modules
	| glob_module == mod_index
		# (class_def, class_defs) = class_defs![ds_index]
		= (class_def, class_defs, modules)
		# (dcl_mod, modules) = modules![glob_module]
		= (dcl_mod.dcl_common.com_class_defs.[ds_index], class_defs, modules)
		
getMemberDef :: !Int Int !Int !u:{#MemberDef} !v:{#DclModule} -> (!MemberDef,!u:{#MemberDef},!v:{#DclModule})
getMemberDef mem_mod mem_index mod_index member_defs modules
	| mem_mod == mod_index
		# (member_def,member_defs) = member_defs![mem_index]
		= (member_def, member_defs, modules)
		# (dcl_mod,modules) = modules![mem_mod]
		= (dcl_mod.dcl_common.com_member_defs.[mem_index], member_defs, modules)

getGenericDef :: !(Global DefinedSymbol) !Int !u:{#GenericDef} !v:{#DclModule} -> (!GenericDef,!u:{#GenericDef},!v:{#DclModule})
getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_defs modules
	| glob_module == mod_index
		# (generic_def, generic_defs) = generic_defs![ds_index]
		= (generic_def, generic_defs, modules)
		# (dcl_mod, modules) = modules![glob_module]
		= (dcl_mod.dcl_common.com_generic_defs.[ds_index], generic_defs, modules)

instantiateTypes :: ![TypeVar] ![AttributeVar] ![AType] ![TypeContext] ![AttrInequality] !SpecialSubstitution ![SpecialSubstitution] !*TypeHeaps !*ErrorAdmin
	-> (![TypeVar], ![AttributeVar], ![AType], ![TypeContext], ![AttrInequality], ![SpecialSubstitution], !*TypeHeaps, !*ErrorAdmin)
instantiateTypes old_type_vars old_attr_vars types type_contexts attr_env {ss_environ, ss_vars, ss_attrs, ss_context} special_subst_list type_heaps=:{th_vars, th_attrs} error
	# th_vars = clear_vars old_type_vars th_vars

	  (new_type_vars, th_vars) = foldSt build_var_subst ss_vars ([], th_vars)
	  (new_attr_vars, th_attrs) = foldSt build_attr_var_subst ss_attrs ([], th_attrs)

	  type_heaps = foldSt build_type_subst ss_environ { type_heaps & th_vars = th_vars, th_attrs = th_attrs }
	  (ok1, new_ss_context, type_heaps) = substitute ss_context type_heaps

	  (inst_vars, th_vars)			= foldSt determine_free_var old_type_vars (new_type_vars, type_heaps.th_vars) 
	  (inst_attr_vars, th_attrs)	= foldSt build_attr_var_subst old_attr_vars (new_attr_vars, type_heaps.th_attrs)

	  (inst_types, (ok2, type_heaps))	= mapSt substitue_arg_type types (True, { type_heaps & th_vars = th_vars, th_attrs = th_attrs })
//	  (ok2, inst_types, type_heaps)		= substitute types { type_heaps & th_vars = th_vars, th_attrs = th_attrs }
	  (ok3, inst_contexts, type_heaps)	= substitute type_contexts type_heaps
	  (ok4, inst_attr_env, type_heaps)	= substitute attr_env type_heaps
	  (special_subst_list, th_vars) 	= mapSt adjust_special_subst special_subst_list type_heaps.th_vars
	  error = case ok1 && ok2 && ok3 && ok4 of
	  				True
	  					-> error
	  				False
	  					-> checkError "instance type incompatible with class type" "" error

	= (inst_vars, inst_attr_vars, inst_types, new_ss_context ++ inst_contexts, inst_attr_env, special_subst_list, { type_heaps & th_vars = th_vars }, error)
where
	clear_vars type_vars type_var_heap = foldSt (\tv -> writePtr tv.tv_info_ptr TVI_Empty) type_vars type_var_heap
	
	determine_free_var tv=:{tv_info_ptr} (free_vars, type_var_heap)
		# (type_var_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
		= case type_var_info of
			TVI_Empty
				-> build_var_subst tv (free_vars, type_var_heap)
			_
				-> (free_vars, type_var_heap)

	build_type_subst {bind_src,bind_dst} type_heaps
		# (_, bind_src, type_heaps) = substitute bind_src type_heaps
// RWS ...
/*
	FIXME: this is a patch for the following incorrect function type (in a dcl module)


    f :: a | c a b special
        a=[], b = Int
        a=T, b = Char

   The type variable b doesn't occur in f's type, but this is checked in a later
   phase. Probably it's a better solution to change the order of checking.

*/
		| isNilPtr bind_dst.tv_info_ptr
			= type_heaps
// ... RWS
		= { type_heaps & th_vars = writePtr bind_dst.tv_info_ptr (TVI_Type bind_src) type_heaps.th_vars}

	substitue_arg_type at=:{at_type = TFA type_vars type} (was_ok, type_heaps)
		# (fresh_type_vars, type_heaps) = foldSt build_avar_subst type_vars ([], type_heaps)
		  (ok, new_at, type_heaps) = substitute {at & at_type = type} type_heaps
		= ({ new_at & at_type = TFA fresh_type_vars new_at.at_type}, (was_ok && ok, type_heaps))
	substitue_arg_type type (was_ok, type_heaps)
		# (ok, type, type_heaps) = substitute type type_heaps
		= (type, (was_ok && ok, type_heaps))
		
	build_var_subst var (free_vars, type_var_heap)
		# (new_info_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap
		  new_fv = { var & tv_info_ptr = new_info_ptr}
	  	= ([ new_fv : free_vars ], writePtr var.tv_info_ptr (TVI_Type (TV new_fv)) type_var_heap)

	build_avar_subst atv=:{atv_variable,atv_attribute} (free_vars, type_heaps)
		# (new_info_ptr, th_vars) = newPtr TVI_Empty type_heaps.th_vars
		  new_fv = { atv_variable & tv_info_ptr = new_info_ptr}
		  th_vars = th_vars <:= (atv_variable.tv_info_ptr, TVI_Type (TV new_fv))
		  (new_attr, th_attrs) = build_attr_subst atv_attribute type_heaps.th_attrs
		= ([ { atv & atv_variable = new_fv, atv_attribute = new_attr } : free_vars], { type_heaps & th_vars = th_vars, th_attrs = th_attrs })
	where		  
		 build_attr_subst (TA_Var avar) attr_var_heap
			# (new_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap
			  new_attr = { avar & av_info_ptr = new_info_ptr}
			= (TA_Var new_attr, attr_var_heap <:= (avar.av_info_ptr, AVI_Attr (TA_Var new_attr)))
		 build_attr_subst attr attr_var_heap
			= (attr, attr_var_heap)

	build_attr_var_subst attr (free_attrs, attr_var_heap)
		# (new_info_ptr, attr_var_heap) = newPtr AVI_Empty attr_var_heap
		  new_attr = { attr & av_info_ptr = new_info_ptr}
		= ([new_attr : free_attrs], writePtr attr.av_info_ptr (AVI_Attr (TA_Var new_attr)) attr_var_heap)
	
	adjust_special_subst special_subst=:{ss_environ} type_var_heap
		# (ss_environ, type_var_heap) = mapSt adjust_special_bind ss_environ type_var_heap
		= ({ special_subst & ss_environ = ss_environ }, type_var_heap)
		
	adjust_special_bind bind=:{bind_dst={tv_info_ptr}} type_var_heap
		# (TVI_Type (TV new_tv), type_var_heap) = readPtr tv_info_ptr type_var_heap
		= ({ bind & bind_dst = new_tv }, type_var_heap)

determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !u:(Optional (v:{#DclModule}, w:{#CheckedTypeDef}, Index)) !*ErrorAdmin
		-> (!SymbolType, !Specials, !*TypeHeaps, !u:Optional (v:{#DclModule}, w:{#CheckedTypeDef}), !*ErrorAdmin)
determineTypeOfMemberInstance mem_st class_vars {it_types,it_vars,it_attr_vars,it_context} specials type_heaps opt_modules error
	# env = { ss_environ = foldl2 (\binds var type -> [ {bind_src = type, bind_dst = var} : binds]) [] class_vars it_types,
			  ss_context = it_context, ss_vars = it_vars, ss_attrs = it_attr_vars} 
	  (st, specials, type_heaps, error)
	  		= determine_type_of_member_instance mem_st env specials type_heaps error
	  (type_heaps, opt_modules, error)
	  		= check_attribution_consistency mem_st type_heaps opt_modules error
	= (st, specials, type_heaps, opt_modules, error)
where
	determine_type_of_member_instance mem_st=:{st_context} env (SP_Substitutions substs) type_heaps error
		# (mem_st, substs, type_heaps, error) 
				= substitute_symbol_type { mem_st &  st_context = tl st_context } env substs type_heaps error
		= (mem_st, SP_Substitutions substs, type_heaps, error) 
	determine_type_of_member_instance mem_st=:{st_context} env SP_None type_heaps error
		# (mem_st, _, type_heaps, error)
				= substitute_symbol_type { mem_st &  st_context = tl st_context } env [] type_heaps error
		= (mem_st, SP_None, type_heaps, error)

	substitute_symbol_type st=:{st_vars,st_attr_vars,st_args,st_result,st_context,st_attr_env} environment specials type_heaps error
		# (st_vars, st_attr_vars, [st_result : st_args], st_context, st_attr_env, specials, type_heaps, error)
			= instantiateTypes st_vars st_attr_vars [ st_result : st_args ] st_context st_attr_env environment specials type_heaps error
		= ({st & st_vars = st_vars, st_args = st_args, st_result = st_result, st_attr_vars = st_attr_vars,
			st_context = st_context, st_attr_env = st_attr_env }, specials, type_heaps, error)

	check_attribution_consistency {st_args, st_result} type_heaps No error
		= (type_heaps, No, error)
	check_attribution_consistency {st_args, st_result} type_heaps=:{th_vars} (Yes (modules, type_defs, x_main_dcl_module_n)) error
		// it is assumed that all type vars bindings done in instantiateTypes are still valid
		# (_, th_vars, modules, type_defs, error)
				= foldSt (foldATypeSt (check_it x_main_dcl_module_n) (\_ st -> st))
						[st_result:st_args]
						(False, th_vars, modules, type_defs, error)
		= ({ type_heaps & th_vars = th_vars }, Yes (modules, type_defs), error)
	
	check_it _ {at_attribute} (error_already_given, th_vars, modules, type_defs, error)
		| at_attribute==TA_Unique || error_already_given
			= (error_already_given, th_vars, modules, type_defs, error)
		// otherwise GOTO next alternative
	check_it x_main_dcl_module_n {at_type=TV tv} (_, th_vars, modules, type_defs, error)
  		= must_not_be_essentially_unique x_main_dcl_module_n tv th_vars modules type_defs error
	check_it x_main_dcl_module_n {at_type= (CV tv) :@: _} (_, th_vars, modules, type_defs, error)
  		= must_not_be_essentially_unique x_main_dcl_module_n tv th_vars modules type_defs error
	check_it _ _ state
		= state
		
	must_not_be_essentially_unique x_main_dcl_module_n {tv_name, tv_info_ptr} th_vars modules type_defs error
		# (TVI_Type type, th_vars) = readPtr tv_info_ptr th_vars
		= case type of
			TA {type_name, type_index} _
				-> must_not_be_essentially_unique_for_TA type_name type_index th_vars
			TAS {type_name, type_index} _ _
				-> must_not_be_essentially_unique_for_TA type_name type_index th_vars
			_
				-> (False, th_vars, modules, type_defs, error)
		where
			must_not_be_essentially_unique_for_TA type_name type_index th_vars
				# (type_def, type_defs, modules)
						= getTypeDef x_main_dcl_module_n type_index type_defs modules
				= case type_def.td_attribute of
					TA_Unique
						-> (True, th_vars, modules, type_defs,
							checkError type_name 
								(   "is unique but instanciates class variable "
								 +++tv_name.id_name
								 +++" that is non uniquely used in a member type"
								) error
						   )
					_
						-> (False, th_vars, modules, type_defs, error)
		
getTypeDef :: !Index !(Global Index) !v:{#CheckedTypeDef} !w:{#DclModule}
		-> (!CheckedTypeDef, !v:{#CheckedTypeDef}, !w:{#DclModule})
getTypeDef x_main_dcl_module_n {glob_module,glob_object} type_defs modules
	| glob_module==x_main_dcl_module_n
		# (type_def, type_defs)
				= type_defs![glob_object]
		= (type_def, type_defs, modules)
	# (type_def, modules)
			= modules![glob_module].dcl_common.com_type_defs.[glob_object]
	= (type_def, type_defs, modules)
		
determineTypesOfInstances :: !Index !Index !*{#ClassInstance} !*{# ClassDef} !*{# MemberDef} 
							 !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState
	-> (![FunType], !Index, ![ClassInstance], !*{#ClassInstance}, !*{# ClassDef}, !*{# MemberDef}, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState)
determineTypesOfInstances first_memb_inst_index mod_index com_instance_defs com_class_defs com_member_defs
		modules type_heaps var_heap cs=:{cs_error,cs_predef_symbols,cs_x={x_main_dcl_module_n}}
	| cs_error.ea_ok
		#! nr_of_class_instances = size com_instance_defs
		# (memb_inst_defs, next_mem_inst_index, all_class_specials, com_class_defs, com_member_defs, modules, com_instance_defs, type_heaps, var_heap, cs_predef_symbols,cs_error)
				= determine_types_of_instances x_main_dcl_module_n 0 nr_of_class_instances first_memb_inst_index mod_index [] com_class_defs com_member_defs 
						modules com_instance_defs type_heaps var_heap cs_predef_symbols cs_error
		= (memb_inst_defs, next_mem_inst_index, all_class_specials, com_instance_defs, com_class_defs,
		   com_member_defs, modules, type_heaps, var_heap, { cs & cs_predef_symbols=cs_predef_symbols,cs_error = cs_error })
		= ([], first_memb_inst_index, [], com_instance_defs, com_class_defs, com_member_defs, modules, type_heaps, var_heap, cs)
where
	determine_types_of_instances :: !Index !Index !Index !Index !Index ![ClassInstance] !v:{#ClassDef} !w:{#MemberDef}
		!x:{#DclModule} !*{#ClassInstance} !*TypeHeaps !*VarHeap !*PredefinedSymbols !*ErrorAdmin
			-> (![FunType], !Index, ![ClassInstance], !v:{#ClassDef}, !w:{#MemberDef}, !x:{#DclModule}, !*{#ClassInstance}, !*TypeHeaps, !*VarHeap, !*PredefinedSymbols,!*ErrorAdmin)
	determine_types_of_instances x_main_dcl_module_n inst_index next_class_inst_index next_mem_inst_index mod_index all_class_specials
			class_defs member_defs modules instance_defs type_heaps var_heap predef_symbols error
		| inst_index < size instance_defs
			# (instance_def=:{ins_class,ins_pos,ins_type,ins_specials}, instance_defs) = instance_defs![inst_index]
			# ({class_name, class_members}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules
			  class_size = size class_members
			  (ins_members, memb_inst_defs1, member_defs, modules, type_heaps, var_heap, error)
			  		= determine_instance_symbols_and_types x_main_dcl_module_n next_mem_inst_index 0 mod_index ins_class.glob_module class_size class_members
			  				ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap error
			  instance_def = { instance_def & ins_members = { member \\ member <- ins_members }}
			  (ins_specials, next_class_inst_index, all_class_specials, type_heaps, predef_symbols,error)
					= check_instance_specials mod_index instance_def inst_index ins_specials next_class_inst_index all_class_specials type_heaps predef_symbols error
			  (memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, modules, instance_defs, type_heaps, var_heap, predef_symbols,error)
			  		= determine_types_of_instances x_main_dcl_module_n (inc inst_index) next_class_inst_index (next_mem_inst_index + class_size) mod_index all_class_specials
			  				class_defs member_defs modules { instance_defs & [inst_index] = { instance_def & ins_specials = ins_specials }} type_heaps var_heap predef_symbols error

			= (memb_inst_defs1 ++ memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, modules, instance_defs, type_heaps, var_heap, predef_symbols,error)
			= ([], next_mem_inst_index, all_class_specials, class_defs, member_defs, modules, instance_defs, type_heaps, var_heap, predef_symbols,error)

	determine_instance_symbols_and_types :: !Index !Index !Index !Index !Index !Int !{#DefinedSymbol} !InstanceType !Specials Ident !Position
			!w:{#MemberDef} !u:{#DclModule} !*TypeHeaps !*VarHeap !*ErrorAdmin
					-> (![DefinedSymbol], ![FunType], !w:{#MemberDef}, !u:{#DclModule}, !*TypeHeaps, !*VarHeap, !.ErrorAdmin)
	determine_instance_symbols_and_types x_main_dcl_module_n first_inst_index mem_offset module_index member_mod_index class_size class_members
			ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap cs_error
		| mem_offset == class_size
			=  ([], [], member_defs, modules, type_heaps, var_heap, cs_error)
			# class_member = class_members.[mem_offset]
			  ({me_symb,me_type,me_priority,me_class_vars}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules
			  cs_error
			  		= pushErrorAdmin (newPosition class_name ins_pos) cs_error
			  (instance_type, new_ins_specials, type_heaps, Yes (modules, _), cs_error)
			  		= determineTypeOfMemberInstance me_type me_class_vars ins_type ins_specials type_heaps (Yes (modules, {}, cUndef)) cs_error
			  cs_error
			  		= popErrorAdmin cs_error
			  (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
			  inst_def = MakeNewFunctionType me_symb me_type.st_arity me_priority instance_type ins_pos new_ins_specials new_info_ptr
			  (inst_symbols, memb_inst_defs, member_defs, modules, type_heaps, var_heap, cs_error)
			  		= determine_instance_symbols_and_types x_main_dcl_module_n first_inst_index (inc mem_offset) module_index member_mod_index
			  				class_size class_members ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap cs_error
			= ([{ class_member & ds_index = first_inst_index +  mem_offset } : inst_symbols], [inst_def : memb_inst_defs], member_defs, modules, type_heaps, var_heap, cs_error)

	check_instance_specials :: !Index !ClassInstance !Index !Specials !Index ![ClassInstance] !*TypeHeaps !*PredefinedSymbols !*ErrorAdmin
		-> (!Specials, !Index, ![ClassInstance], !*TypeHeaps, !*PredefinedSymbols,!*ErrorAdmin)
	check_instance_specials mod_index inst_type inst_index (SP_Substitutions substs) next_inst_index all_instances type_heaps predef_symbols error
		# (list_of_specials, next_inst_index, all_instances, type_heaps, predef_symbols,error)
			= check_specials mod_index inst_type 0 substs [] next_inst_index all_instances type_heaps predef_symbols error
		= (SP_ContextTypes list_of_specials, next_inst_index, all_instances, type_heaps, predef_symbols, error)
	where
		check_specials mod_index inst=:{ins_type} type_offset [ subst : substs ] list_of_specials next_inst_index all_instances type_heaps predef_symbols error
			# (special_type, type_heaps, error) = substitute_instance_type ins_type subst type_heaps error
			  (spec_types, predef_symbols,error) = checkAndCollectTypesOfContextsOfSpecials special_type.it_context predef_symbols error
			  special = { spec_index = { glob_module = mod_index, glob_object = next_inst_index }, spec_types = spec_types,
			  				spec_vars = subst.ss_vars, spec_attrs = subst.ss_attrs }
			= check_specials mod_index inst (inc type_offset) substs [ special : list_of_specials ] (inc next_inst_index)
					[{ inst & ins_type = { special_type & it_context = [] }, ins_specials = SP_TypeOffset type_offset} : all_instances ] type_heaps predef_symbols error
		where
			substitute_instance_type :: !InstanceType !SpecialSubstitution !*TypeHeaps !*ErrorAdmin -> (!InstanceType,!*TypeHeaps,!.ErrorAdmin)
			substitute_instance_type it=:{it_vars,it_attr_vars,it_types,it_context} environment type_heaps cs_error
				# (it_vars, it_attr_vars, it_atypes, it_context, _, _, type_heaps, cs_error)	
					= instantiateTypes it_vars it_attr_vars [MakeAttributedType type \\ type <- it_types] it_context [] environment [] type_heaps cs_error
				= ({it & it_vars = it_vars, it_types = [ at_type \\ {at_type} <- it_atypes ], it_attr_vars = it_attr_vars, it_context = it_context }, type_heaps, cs_error)

			
		check_specials mod_index inst=:{ins_type} type_offset [] list_of_specials next_inst_index all_instances type_heaps predef_symbols error
			= (list_of_specials,  next_inst_index, all_instances, type_heaps, predef_symbols, error)
	check_instance_specials mod_index fun_type fun_index SP_None next_inst_index all_instances type_heaps predef_symbols error
		= (SP_None, next_inst_index, all_instances, type_heaps, predef_symbols,error)

mapSt2 f l s1 s2 :== map_st2 l s1 s2
where
	map_st2 [x : xs] s1 s2
	 	# (x, s1,s2) = f x s1 s2
		  (xs, s1,s2) = map_st2 xs s1 s2
		#! s1 = s1
		#! s2 = s2
		= ([x : xs], s1,s2)
	map_st2 [] s1 s2
	 	= ([], s1,s2)
	
checkAndCollectTypesOfContextsOfSpecials :: [TypeContext] *PredefinedSymbols *ErrorAdmin -> (![[Type]],!*PredefinedSymbols,!*ErrorAdmin);
checkAndCollectTypesOfContextsOfSpecials type_contexts predef_symbols error
	= mapSt2 check_and_collect_context_types_of_special type_contexts predef_symbols error
where	
	check_and_collect_context_types_of_special {tc_class={glob_object={ds_ident,ds_index},glob_module},tc_types} predef_symbols error
		| hasNoTypeVariables tc_types
			= (tc_types, predef_symbols,error)
		# {pds_def,pds_module} = predef_symbols.[PD_ArrayClass]
		| glob_module==pds_module && ds_index==pds_def && is_lazy_or_strict_array tc_types predef_symbols
			= (tc_types, predef_symbols,error)
		# {pds_def,pds_module} = predef_symbols.[PD_ListClass]
		| glob_module==pds_module && ds_index==pds_def && is_lazy_or_strict_list tc_types predef_symbols
			= (tc_types, predef_symbols,error)
			= (tc_types, predef_symbols,checkError ds_ident.id_name "illegal specialization" error)

	hasNoTypeVariables []
		= True
	hasNoTypeVariables [TV tvar : types]
		= False
	hasNoTypeVariables [ _ : types]
		= hasNoTypeVariables types
	
	is_lazy_or_strict_array [TA {type_index={glob_module,glob_object}} [],TV var] predef_symbols
		# {pds_def,pds_module} = predef_symbols.[PD_LazyArrayType]
		| glob_module==pds_module && glob_object==pds_def
			= True
		# {pds_def,pds_module} = predef_symbols.[PD_StrictArrayType]
		| glob_module==pds_module && glob_object==pds_def
			= True
			= False
	is_lazy_or_strict_array _ predef_symbols
		= False

	is_lazy_or_strict_list [TA {type_index={glob_module,glob_object}} [],TV var] predef_symbols
		# {pds_def,pds_module} = predef_symbols.[PD_ListType]
		| glob_module==pds_module && glob_object==pds_def
			= True
		# {pds_def,pds_module} = predef_symbols.[PD_StrictListType]
		| glob_module==pds_module && glob_object==pds_def
			= True
		# {pds_def,pds_module} = predef_symbols.[PD_TailStrictListType]
		| glob_module==pds_module && glob_object==pds_def
			= True
		# {pds_def,pds_module} = predef_symbols.[PD_StrictTailStrictListType]
		| glob_module==pds_module && glob_object==pds_def
			= True
			= False
	is_lazy_or_strict_list _ predef_symbols
		= False

initializeContextVariables :: ![TypeContext] !*VarHeap ->  (![TypeContext], !*VarHeap)
initializeContextVariables contexts var_heap
	= mapSt add_variable_to_context contexts var_heap
where
	add_variable_to_context context var_heap
		# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
		= ({ context & tc_var = new_info_ptr}, var_heap)

ident_for_errors_from_fun_symb_and_fun_kind :: Ident FunKind -> Ident;
ident_for_errors_from_fun_symb_and_fun_kind {id_name} (FK_Function fun_name_is_location_dependent)
	| fun_name_is_location_dependent && size id_name>0
		# beautiful_name = if (id_name.[0]==backslash) "lambda" "comprehension"
		= { id_name=beautiful_name, id_info=nilPtr }
ident_for_errors_from_fun_symb_and_fun_kind fun_symb _
	= fun_symb

// check that there are no strict lets, mark top-level cases as explicit
class checkMacro a :: !Bool !a !*ErrorAdmin -> (!a, !*ErrorAdmin)

instance checkMacro [a] | checkMacro a where
	checkMacro topLevel l ea
		=	mapSt (checkMacro topLevel) l ea

instance checkMacro FunctionBody where
	checkMacro topLevel (CheckedBody body) ea
		# (body, ea)
			=	checkMacro topLevel body ea
		= (CheckedBody body, ea)

instance checkMacro CheckedBody where
	checkMacro topLevel body=:{cb_rhs} ea
		# (cb_rhs, ea)
			=	checkMacro topLevel cb_rhs ea
		= ({body & cb_rhs = cb_rhs}, ea)

instance checkMacro CheckedAlternative where
	checkMacro topLevel alt=:{ca_rhs} ea
		# (ca_rhs, ea)
			=	checkMacro topLevel ca_rhs ea
		= ({alt & ca_rhs = ca_rhs}, ea)

instance checkMacro Expression where
	checkMacro topLevel (Let lad) ea
		# (lad, ea)
			=	checkMacro topLevel lad ea
		=	(Let lad, ea)
	checkMacro topLevel (Case kees) ea
		# (kees, ea)
			=	checkMacro topLevel kees ea
		=	(Case kees, ea)
	checkMacro _ expr ea
		=	(expr, ea)

instance checkMacro Let where
	checkMacro topLevel lad=:{let_strict_binds, let_expr} ea
		# ea
			=	check_strict_binds let_strict_binds ea
		# (let_expr, ea)
			=	checkMacro topLevel let_expr ea
		= ({lad & let_expr = let_expr}, ea)
		where
			check_strict_binds [] ea
				=	ea
			check_strict_binds _ ea
				=	checkError "#! not allowed in macros" "" ea

instance checkMacro Case where
	checkMacro topLevel kees=:{case_guards, case_explicit} ea
		# (case_guards, ea)
			=	checkMacro False case_guards ea
		= ({kees & case_guards = case_guards,case_explicit = topLevel || case_explicit}, ea)

instance checkMacro CasePatterns where
	checkMacro topLevel (AlgebraicPatterns type patterns) ea
		# (patterns, ea)
			=	checkMacro topLevel patterns ea	
		=	(AlgebraicPatterns type patterns, ea)
	checkMacro topLevel (BasicPatterns type patterns) ea
		# (patterns, ea)
			=	checkMacro topLevel patterns ea	
		=	(BasicPatterns type patterns, ea)
	checkMacro topLevel (DynamicPatterns patterns) ea
		# (patterns, ea)
			=	checkMacro topLevel patterns ea	
		=	(DynamicPatterns patterns, ea)
	checkMacro topLevel (OverloadedListPatterns type decons patterns) ea
		# (patterns, ea)
			=	checkMacro topLevel patterns ea	
		=	(OverloadedListPatterns type decons patterns, ea)
	checkMacro _ NoPattern ea
		=	(NoPattern, ea)

instance checkMacro AlgebraicPattern where
	checkMacro topLevel pattern=:{ap_expr} ea
		# (ap_expr, ea)
			=	checkMacro topLevel ap_expr ea	
		=	({pattern & ap_expr = ap_expr}, ea)

instance checkMacro BasicPattern where
	checkMacro topLevel pattern=:{bp_expr} ea
		# (bp_expr, ea)
			=	checkMacro topLevel bp_expr ea	
		=	({pattern & bp_expr = bp_expr}, ea)

instance checkMacro DynamicPattern where
	checkMacro topLevel pattern=:{dp_rhs} ea
		# (dp_rhs, ea)
			=	checkMacro topLevel dp_rhs ea	
		=	({pattern & dp_rhs = dp_rhs}, ea)

checkFunctionBodyIfMacro :: !FunKind !FunctionBody !*ErrorAdmin -> (!FunctionBody, !*ErrorAdmin)
checkFunctionBodyIfMacro FK_Macro def ea
	=	checkMacro True def ea
checkFunctionBodyIfMacro _ def ea
	=	(def, ea)

checkFunction :: !FunDef !Index !FunctionOrMacroIndex !Level !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
													  -> (!FunDef,!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState);
checkFunction fun_def=:{fun_symb,fun_pos,fun_body,fun_type,fun_kind} mod_index fun_index def_level local_functions_index_offset
			fun_defs e_info=:{ef_type_defs,ef_modules,ef_class_defs,ef_is_macro_fun} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps,hp_generic_heap} cs=:{cs_error}			
	# function_ident_for_errors = ident_for_errors_from_fun_symb_and_fun_kind fun_symb fun_kind
	# cs = {cs & cs_error = pushErrorAdmin (newPosition function_ident_for_errors fun_pos) cs_error}

	  (fun_type, ef_type_defs, ef_class_defs, ef_modules, hp_var_heap, hp_type_heaps, cs)
			= check_function_type fun_type mod_index (fun_kind == FK_Caf) ef_type_defs ef_class_defs ef_modules hp_var_heap hp_type_heaps cs
	  e_info  = { e_info & ef_type_defs = ef_type_defs, ef_class_defs = ef_class_defs, ef_modules = ef_modules }
	  e_state = {   es_var_heap = hp_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps,es_generic_heap=hp_generic_heap,
	  				es_dynamics = [], es_calls = [], es_fun_defs = fun_defs}
	  e_input = { ei_expr_level = inc def_level, ei_fun_index = fun_index, ei_fun_level = inc def_level, ei_mod_index = mod_index, ei_local_functions_index_offset=local_functions_index_offset }
	  (fun_body, free_vars, e_state, e_info, cs) = checkFunctionBodies fun_body function_ident_for_errors e_input e_state e_info cs

	# {es_fun_defs,es_calls,es_var_heap,es_expr_heap,es_type_heaps,es_generic_heap,es_dynamics} = e_state
	  (ef_type_defs, ef_modules, es_type_heaps, es_expr_heap, cs) = 
	  	checkDynamicTypes mod_index es_dynamics fun_type e_info.ef_type_defs e_info.ef_modules es_type_heaps es_expr_heap cs
	  (fun_body, cs_error) = checkFunctionBodyIfMacro fun_kind fun_body cs.cs_error
	  cs = { cs & cs_error = popErrorAdmin cs_error }
	  fi_properties = (if ef_is_macro_fun FI_IsMacroFun 0) bitor (has_type fun_type)
	  fun_info = { fun_def.fun_info & fi_calls = es_calls, fi_def_level = def_level, fi_free_vars = free_vars, fi_dynamics = es_dynamics,
	  								  fi_properties = fi_properties }
  
	  fun_def = { fun_def & fun_body = fun_body, fun_info = fun_info, fun_type = fun_type}
	  (fun_defs,macro_defs,cs_symbol_table) = remove_calls_from_symbol_table fun_index def_level es_calls e_state.es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table
	= (fun_def,fun_defs,
			{ e_info & ef_type_defs = ef_type_defs, ef_modules = ef_modules,ef_macro_defs=macro_defs },
			{ heaps & hp_var_heap = es_var_heap, hp_expression_heap = es_expr_heap, hp_type_heaps = es_type_heaps,hp_generic_heap=es_generic_heap }, 
			{ cs & cs_symbol_table = cs_symbol_table })

where
	has_type (Yes _) 	= FI_HasTypeSpec
	has_type no 		= 0
	
	check_function_type (Yes ft) module_index is_caf type_defs class_defs modules var_heap type_heaps cs
		# (ft, _, type_defs, class_defs, modules, type_heaps, cs) = checkFunctionType module_index ft SP_None type_defs class_defs modules type_heaps cs
		  cs = (if is_caf (check_caf_uniqueness ft.st_result.at_attribute) id) cs
		  (st_context, var_heap) = initializeContextVariables ft.st_context var_heap
		= (Yes { ft & st_context = st_context } , type_defs,  class_defs, modules, var_heap, type_heaps, cs)
		where
			check_caf_uniqueness TA_None cs
				=	cs
			check_caf_uniqueness TA_Multi cs
				=	cs
			check_caf_uniqueness _ cs
				= {cs & cs_error = checkError "result type of CAF must be non-unique " "" cs.cs_error}
	check_function_type No module_index _ type_defs class_defs modules var_heap type_heaps cs
		= (No, type_defs,  class_defs, modules, var_heap, type_heaps, cs)

	remove_calls_from_symbol_table fun_index fun_level [FunCall fc_index fc_level : fun_calls] fun_defs macro_defs symbol_table
		| fc_level <= fun_level
			# (id_info, fun_defs) = fun_defs![fc_index].fun_symb.id_info
			# (entry, symbol_table) = readPtr id_info symbol_table
			# symbol_table = remove_call entry.ste_kind fun_index entry id_info symbol_table
			= remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table
			= remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table
	remove_calls_from_symbol_table fun_index fun_level [MacroCall module_index fc_index fc_level : fun_calls] fun_defs macro_defs symbol_table
		| fc_level <= fun_level
			# (id_info, macro_defs) = macro_defs![module_index,fc_index].fun_symb.id_info
			# (entry, symbol_table) = readPtr id_info symbol_table
			# symbol_table = remove_call entry.ste_kind fun_index entry id_info symbol_table
			= remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table
			= remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table
	remove_calls_from_symbol_table fun_index fun_level [] fun_defs macro_defs symbol_table
		= (fun_defs,macro_defs,symbol_table)

	remove_call (STE_FunctionOrMacro [x:xs]) fun_index entry id_info symbol_table
		| fun_index==x
			= symbol_table <:= (id_info,{ entry & ste_kind = STE_FunctionOrMacro xs})
	remove_call (STE_DclMacroOrLocalMacroFunction [x:xs]) fun_index entry id_info symbol_table
		| fun_index==x
			= symbol_table <:= (id_info,{ entry & ste_kind = STE_DclMacroOrLocalMacroFunction xs})
	remove_call (STE_Imported (STE_DclMacroOrLocalMacroFunction [x:xs]) mod_index) fun_index entry id_info symbol_table
		| fun_index==x
			= symbol_table <:= (id_info,{ entry & ste_kind = (STE_Imported (STE_DclMacroOrLocalMacroFunction xs) mod_index)})

checkGlobalFunctionsInRanges:: ![IndexRange] !Index !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
													 -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState)
checkGlobalFunctionsInRanges [{ir_from,ir_to}:ranges] mod_index local_functions_index_offset fun_defs e_info heaps cs
	# (fun_defs, e_info, heaps, cs)
		= checkFunctions mod_index cGlobalScope ir_from ir_to local_functions_index_offset fun_defs e_info heaps cs;
	= checkGlobalFunctionsInRanges ranges mod_index local_functions_index_offset fun_defs e_info heaps cs;
checkGlobalFunctionsInRanges [] mod_index local_functions_index_offset fun_defs e_info heaps cs
	= (fun_defs, e_info, heaps, cs)

checkFunctions :: !Index !Level !Index !Index !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
											   -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState)
checkFunctions mod_index level fun_index to_index local_functions_index_offset fun_defs e_info heaps cs
	| fun_index == to_index
		= (fun_defs, e_info, heaps, cs)
		# (fun_def,fun_defs) = fun_defs![fun_index]
		# (fun_def,fun_defs, e_info, heaps, cs) = checkFunction fun_def mod_index (FunctionOrIclMacroIndex fun_index) level local_functions_index_offset fun_defs e_info heaps cs
		# fun_defs = { fun_defs & [fun_index] = fun_def }
		= checkFunctions mod_index level (inc fun_index) to_index local_functions_index_offset fun_defs e_info heaps cs
			
checkDclMacros :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
										  -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState)
checkDclMacros mod_index level fun_index to_index fun_defs e_info heaps cs
	| fun_index == to_index
		= (fun_defs, e_info, heaps, cs)
		# (macro_def,e_info) = e_info!ef_macro_defs.[mod_index,fun_index]
		# (macro_def,fun_defs, e_info, heaps, cs) = checkFunction macro_def mod_index (DclMacroIndex mod_index fun_index) level 0 fun_defs e_info heaps cs
		# e_info = { e_info & ef_macro_defs.[mod_index,fun_index] = macro_def }
		= checkDclMacros mod_index level (inc fun_index) to_index fun_defs e_info heaps cs

get_predef_symbols_for_transform :: *PredefinedSymbols -> (!PredefSymbolsForTransform,!.PredefinedSymbols)
// clean 2.0 does not allow this, clean 1.3 does:
// get_predef_symbols_for_transform cs_predef_symbols=:{[PD_DummyForStrictAliasFun]=predef_alias_dummy,[PD_AndOp]=predef_and,[PD_OrOp]=predef_or}
get_predef_symbols_for_transform cs_predef_symbols
	# (predef_alias_dummy,cs_predef_symbols) = cs_predef_symbols![PD_DummyForStrictAliasFun]
	# (predef_and,cs_predef_symbols) = cs_predef_symbols![PD_AndOp]
	# (predef_or,cs_predef_symbols) = cs_predef_symbols![PD_OrOp]
	= ({predef_alias_dummy=predef_alias_dummy,predef_and=predef_and,predef_or=predef_or},cs_predef_symbols)

checkAndPartitionateDclMacros ::  !Index !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
												 -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState);
checkAndPartitionateDclMacros mod_index range fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_old} heaps cs
	# (fun_defs, e_info, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table, cs_predef_symbols, cs_error})
			= checkDclMacros mod_index cGlobalScope range.ir_from range.ir_to fun_defs { e_info & ef_is_macro_fun=True } heaps cs
	  (e_info=:{ef_modules,ef_macro_defs}) = { e_info & ef_is_macro_fun=ef_is_macro_fun_old }
	# (predef_symbols_for_transform, cs_predef_symbols) = get_predef_symbols_for_transform cs_predef_symbols
	  (fun_defs, macro_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error)
	  		= partitionateDclMacros range mod_index predef_symbols_for_transform fun_defs ef_macro_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error
	= (fun_defs, { e_info & ef_modules = ef_modules,ef_macro_defs=macro_defs }, {heaps &  hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap},
			{ cs & cs_symbol_table = cs_symbol_table, cs_predef_symbols = cs_predef_symbols, cs_error = cs_error })

checkAndPartitionateIclMacros ::  !Index !IndexRange !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
													  -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState);
checkAndPartitionateIclMacros mod_index range local_functions_index_offset fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_old} heaps cs
	# (fun_defs, e_info, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table, cs_predef_symbols, cs_error})
			= checkFunctions mod_index cGlobalScope range.ir_from range.ir_to local_functions_index_offset fun_defs { e_info & ef_is_macro_fun=True } heaps cs
	  (e_info=:{ef_modules,ef_macro_defs}) = { e_info & ef_is_macro_fun=ef_is_macro_fun_old }
	# (predef_symbols_for_transform, cs_predef_symbols) = get_predef_symbols_for_transform cs_predef_symbols
	  (fun_defs, macro_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error)
	  		= partitionateIclMacros range mod_index predef_symbols_for_transform fun_defs ef_macro_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error
	= (fun_defs, { e_info & ef_modules = ef_modules,ef_macro_defs=macro_defs }, {heaps &  hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap},
			{ cs & cs_symbol_table = cs_symbol_table, cs_predef_symbols = cs_predef_symbols, cs_error = cs_error })

checkInstanceBodies :: ![IndexRange] !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
									  -> (!*{#FunDef},!*ExpressionInfo,!*Heaps, !*CheckState);
checkInstanceBodies icl_instances_ranges local_functions_index_offset fun_defs e_info heaps cs=:{cs_x}
	= checkGlobalFunctionsInRanges icl_instances_ranges cs_x.x_main_dcl_module_n local_functions_index_offset fun_defs e_info heaps cs

instance < FunDef 
where
	(<) fd1 fd2 = fd1.fun_symb.id_name < fd2.fun_symb.id_name

createCommonDefinitions :: (CollectedDefinitions ClassInstance a) -> .CommonDefs;
createCommonDefinitions {def_types,def_constructors,def_selectors,def_classes,def_members,def_instances, def_generics,def_generic_cases}
	=	{	com_type_defs		= { type \\ type <- def_types }
		,	com_cons_defs		= { cons \\ cons <- def_constructors }
		,	com_selector_defs	= { sel \\ sel <- def_selectors }
		,	com_class_defs		= { class_def \\ class_def <- def_classes }
		,	com_member_defs		= { member \\ member <- def_members }
		,	com_instance_defs	= { next_instance \\ next_instance <- def_instances }
		,	com_generic_defs	= { gen \\ gen <- def_generics }
		, 	com_gencase_defs    = { gi \\ gi <- def_generic_cases}		
		}

array_plus_list a [] = a
array_plus_list a l = arrayPlusList a l

checkCommonDefinitions :: !(Optional (CopiedDefinitions, Int)) !Index !*CommonDefs !*{# DclModule} !*Heaps !*CheckState
												  -> (!DictionaryInfo,!*CommonDefs,!*{# DclModule},!*Heaps, !*CheckState)
checkCommonDefinitions opt_icl_info module_index common modules heaps cs
	# (com_type_defs, com_cons_defs, com_selector_defs, modules, heaps, cs)
			= checkTypeDefs module_index opt_icl_info
					common.com_type_defs common.com_cons_defs common.com_selector_defs modules heaps cs
	  (com_class_defs, com_member_defs, com_type_defs, modules, heaps, cs)
	  		= checkTypeClasses module_index opt_icl_info common.com_class_defs common.com_member_defs com_type_defs modules heaps cs
	  (com_member_defs, com_type_defs, com_class_defs, modules, heaps, cs)
	  		= checkMemberTypes module_index opt_icl_info com_member_defs com_type_defs com_class_defs modules heaps cs
	  (com_instance_defs, com_type_defs, com_class_defs, com_member_defs, modules, heaps, cs)
	  		= checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs modules heaps cs
//AA..
	  (com_generic_defs, com_type_defs, com_class_defs, modules, heaps, cs)
			= checkGenericDefs module_index opt_icl_info common.com_generic_defs com_type_defs com_class_defs modules heaps cs
	  (com_gencase_defs, com_generic_defs, com_type_defs, modules, heaps, cs)
			= checkGenericCaseDefs module_index common.com_gencase_defs com_generic_defs com_type_defs modules heaps cs	  
//..AA

	
	  (size_com_type_defs,com_type_defs) = usize com_type_defs
	  (size_com_selector_defs,com_selector_defs) = usize com_selector_defs
	  (size_com_cons_defs,com_cons_defs) = usize com_cons_defs

	  {hp_var_heap, hp_type_heaps=hp_type_heaps=:{th_vars} } = heaps
 	  is_dcl = case opt_icl_info of No -> True ; Yes _ -> False
	  (new_type_defs, new_selector_defs, new_cons_defs,dictionary_info,com_type_defs,com_selector_defs, com_cons_defs, com_class_defs, modules, th_vars, hp_var_heap, cs_symbol_table)
	  	= createClassDictionaries is_dcl module_index size_com_type_defs size_com_selector_defs size_com_cons_defs
							  			com_type_defs com_selector_defs com_cons_defs com_class_defs modules th_vars hp_var_heap cs.cs_symbol_table

	  com_type_defs = array_plus_list com_type_defs new_type_defs
	  com_selector_defs = array_plus_list com_selector_defs new_selector_defs
	  com_cons_defs = array_plus_list com_cons_defs new_cons_defs
	  
	  common = {common & com_type_defs = com_type_defs, com_cons_defs = com_cons_defs, com_selector_defs = com_selector_defs, com_class_defs = com_class_defs,
						 com_member_defs = com_member_defs,  com_instance_defs = com_instance_defs, 
						 com_generic_defs = com_generic_defs, com_gencase_defs = com_gencase_defs}

	  heaps = {heaps & hp_var_heap=hp_var_heap,hp_type_heaps={hp_type_heaps & th_vars=th_vars}}
	= (dictionary_info,common, modules,	heaps, { cs & cs_symbol_table = cs_symbol_table })
		
collectCommonfinitions :: !(CollectedDefinitions ClassInstance a) -> (!*{# Int}, ![Declaration])
collectCommonfinitions {def_types,def_constructors,def_selectors,def_classes,def_members,def_instances, def_generic_cases, def_generics} 
	// MW: the order in which the declarations appear in the returned list is essential (explicit imports)
	# sizes = createArray cConversionTableSize 0
	  (size, defs) = foldSt cons_def_to_dcl def_constructors (0, [])
	  sizes = { sizes & [cConstructorDefs] = size }
	  (size, defs) = foldSt selector_def_to_dcl def_selectors (0, defs)
	  sizes = { sizes & [cSelectorDefs] = size }
	  (size, defs) = foldSt type_def_to_dcl def_types (0, defs)
	  sizes = { sizes & [cTypeDefs] = size }
	  (size, defs) = foldSt member_def_to_dcl def_members (0, defs)
	  sizes = { sizes & [cMemberDefs] = size }
	  (size, defs) = foldSt class_def_to_dcl def_classes (0, defs)
	  sizes = { sizes & [cClassDefs] = size }
	  (size, defs) = foldSt instance_def_to_dcl def_instances (0, defs)
	  sizes = { sizes & [cInstanceDefs] = size }
	  (size, defs) = foldSt generic_def_to_dcl def_generics (0, defs)
	  sizes = { sizes & [cGenericDefs] = size }
	  (size, defs) = foldSt gen_case_def_to_dcl def_generic_cases (0, defs)
	  sizes = { sizes & [cGenericCaseDefs] = size }
	= (sizes, defs)
where
	type_def_to_dcl {td_name, td_pos} (decl_index, decls)
		= (inc decl_index, [Declaration { decl_ident = td_name, decl_pos = td_pos, decl_kind = STE_Type, decl_index = decl_index } : decls]) 
	cons_def_to_dcl {cons_symb, cons_pos} (decl_index, decls)
		= (inc decl_index, [Declaration { decl_ident = cons_symb, decl_pos = cons_pos, decl_kind = STE_Constructor, decl_index = decl_index } : decls]) 
	selector_def_to_dcl {sd_symb, sd_field, sd_pos} (decl_index, decls)
		= (inc decl_index, [Declaration { decl_ident = sd_field, decl_pos = sd_pos, decl_kind = STE_Field sd_symb, decl_index = decl_index } : decls]) 
	class_def_to_dcl {class_name, class_pos} (decl_index, decls)
		= (inc decl_index, [Declaration { decl_ident = class_name, decl_pos = class_pos, decl_kind = STE_Class, decl_index = decl_index } : decls]) 
	member_def_to_dcl {me_symb, me_pos} (decl_index, decls)
		= (inc decl_index, [Declaration { decl_ident = me_symb, decl_pos = me_pos, decl_kind = STE_Member, decl_index = decl_index } : decls]) 
	instance_def_to_dcl {ins_class, ins_ident, ins_pos} (decl_index, decls)
		= (inc decl_index, [Declaration { decl_ident = ins_ident, decl_pos = ins_pos, decl_kind = STE_Instance ins_class.glob_object.ds_ident, decl_index = decl_index } : decls])
	generic_def_to_dcl {gen_name, gen_member_name, gen_type, gen_pos} (decl_index, decls)
		# generic_decl = Declaration { decl_ident = gen_name, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index }
		# member_decl = Declaration { decl_ident = gen_member_name, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index }
		= (inc decl_index, [generic_decl, member_decl : decls]) 
	gen_case_def_to_dcl {gc_name, gc_pos} (decl_index, decls)
		= (inc decl_index, [Declaration { decl_ident = gc_name, decl_pos = gc_pos, decl_kind = STE_GenericCase, decl_index = decl_index } : decls]) 

collectMacros {ir_from,ir_to} macro_defs sizes_defs
	= collectGlobalFunctions cMacroDefs ir_from ir_to macro_defs sizes_defs

collectFunctionTypes fun_types (sizes, defs)
	# (size, defs) = foldSt fun_type_to_dcl fun_types (0, defs)
	= ({ sizes & [cFunctionDefs] = size }, defs)
where
	fun_type_to_dcl {ft_symb, ft_pos} (decl_index, decls) 
		= (inc decl_index, [Declaration { decl_ident = ft_symb, decl_pos = ft_pos, decl_kind = STE_DclFunction, decl_index = decl_index } : decls]) 

collectGlobalFunctions def_index from_index to_index fun_defs (sizes, defs)
	# (defs, fun_defs) = iFoldSt fun_def_to_decl from_index to_index (defs, fun_defs)  
	= (fun_defs, ({ sizes & [def_index] = to_index - from_index }, defs))
where
	fun_def_to_decl decl_index (defs, fun_defs)
		# ({fun_symb, fun_pos}, fun_defs) = fun_defs![decl_index]
		= ([Declaration { decl_ident = fun_symb, decl_pos = fun_pos, decl_kind = STE_FunctionOrMacro [], decl_index = decl_index } : defs], fun_defs)

collectDclMacros {ir_from=from_index,ir_to=to_index} fun_defs (sizes, defs)
	# (defs, fun_defs) = iFoldSt macro_def_to_dcl from_index to_index (defs, fun_defs)  
	= (fun_defs, ({ sizes & [cMacroDefs] = to_index - from_index }, defs))
where
	macro_def_to_dcl decl_index (defs, fun_defs)
		# ({fun_symb, fun_pos}, fun_defs) = fun_defs![decl_index]
		= ([Declaration { decl_ident = fun_symb, decl_pos = fun_pos, decl_kind = STE_DclMacroOrLocalMacroFunction [], decl_index = decl_index } : defs], fun_defs)

gimme_a_lazy_array_type :: !u:{.a} -> v:{.a}, [u<=v]
gimme_a_lazy_array_type a = a

gimme_a_strict_array_type :: !u:{!.a} -> v:{!.a}, [u<=v]
gimme_a_strict_array_type a = a

create_icl_to_dcl_index_table :: !ModuleKind !{#Int} IndexRange !Int !(Optional {#{#Int}}) !*{#DclModule} !*{#FunDef}
																  -> (!Optional {#{#Int}},!Optional {#{#Int}},  !.{#DclModule},!*{#FunDef})
create_icl_to_dcl_index_table MK_Main icl_sizes icl_global_function_range main_dcl_module_n dcl_conversions modules fun_defs
	= (No,No,modules,fun_defs)
create_icl_to_dcl_index_table _ icl_sizes icl_global_function_range main_dcl_module_n old_conversions modules fun_defs
	#! (size_icl_functions,fun_defs) = usize fun_defs
	#! icl_sizes = make_icl_sizes
		with
			make_icl_sizes :: *{#Int}
			make_icl_sizes => {{icl_sizes.[i] \\ i<-[0..cMacroDefs-1]} & [cFunctionDefs]=size_icl_functions}
	#! (dcl_mod,modules) = modules![main_dcl_module_n]
	#! dictionary_info=dcl_mod.dcl_dictionary_info	
	# (Yes conversion_table) = old_conversions
	#! icl_to_dcl_index_table = {create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table table_kind dictionary_info \\ table_kind<-[0..] & table_size <-: icl_sizes & dcl_to_icl_table <-: conversion_table }
	#! modules = {modules & [main_dcl_module_n].dcl_macro_conversions=Yes conversion_table.[cMacroDefs]}
	= (Yes icl_to_dcl_index_table,old_conversions,modules,fun_defs)

recompute_icl_to_dcl_index_table_for_functions No dcl_icl_conversions n_functions
	= No
recompute_icl_to_dcl_index_table_for_functions (Yes icl_to_dcl_index_table) (Yes dcl_icl_conversions) n_functions
	# icl_to_dcl_index_table_for_functions = create_icl_to_dcl_index_table_for_kind n_functions dcl_icl_conversions cFunctionDefs {n_dictionary_types=0, n_dictionary_constructors=0, n_dictionary_selectors=0}
	# icl_to_dcl_index_table = {{t\\t<-:icl_to_dcl_index_table} & [cFunctionDefs] = icl_to_dcl_index_table_for_functions}
	= Yes icl_to_dcl_index_table

create_icl_to_dcl_index_table_for_kind :: !Int !{#Int} Int DictionaryInfo -> {#Int}
create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table table_kind dcl_dictionary_info
	# icl_to_dcl_index_table_for_kind = {createArray table_size NoIndex & [dcl_to_icl_table.[decl_index]]=decl_index \\ decl_index<- [0..size dcl_to_icl_table-1]}
	#! max_index=size icl_to_dcl_index_table_for_kind-1
	# free_position_index =  if (table_kind==cTypeDefs) (max_index+dcl_dictionary_info.n_dictionary_types)
							(if (table_kind==cSelectorDefs) (max_index+dcl_dictionary_info.n_dictionary_selectors)
							(if (table_kind==cConstructorDefs) (max_index+dcl_dictionary_info.n_dictionary_constructors)
							 max_index))
	# icl_to_dcl_index_table_for_kind = number_NoIndex_elements max_index free_position_index icl_to_dcl_index_table_for_kind
		with
			number_NoIndex_elements :: Int Int *{#Int} -> .{#Int};
			number_NoIndex_elements index free_position_index icl_to_dcl_index_table_for_kind
				| index>=0
					| icl_to_dcl_index_table_for_kind.[index]==NoIndex
						= number_NoIndex_elements (index-1) (free_position_index-1) {icl_to_dcl_index_table_for_kind & [index]=free_position_index}
						= number_NoIndex_elements (index-1) free_position_index icl_to_dcl_index_table_for_kind
					= icl_to_dcl_index_table_for_kind
	= icl_to_dcl_index_table_for_kind

renumber_member_indexes_of_class_instances No class_instances
	= class_instances
renumber_member_indexes_of_class_instances (Yes icl_to_dcl_index_table) class_instances
	= renumber_member_indexes_of_class_instances 0 class_instances
	where
		function_conversion_table = icl_to_dcl_index_table.[cFunctionDefs]

		renumber_member_indexes_of_class_instances class_inst_index class_instances
			| class_inst_index < size class_instances
				# (class_instance,class_instances) = class_instances![class_inst_index]
				# new_members = {{icl_member & ds_index=function_conversion_table.[icl_member.ds_index]} \\ icl_member<-:class_instance.ins_members}
				# class_instances = {class_instances & [class_inst_index]={class_instance & ins_members=new_members}}
				= renumber_member_indexes_of_class_instances (class_inst_index+1) class_instances
				= class_instances

renumber_members_of_gencases No gencases
	= gencases
renumber_members_of_gencases (Yes icl_to_dcl_index_table) gencases
	= renumber 0 gencases
where
	function_conversion_table = icl_to_dcl_index_table.[cFunctionDefs]
	
	renumber gencase_index gencases
		| gencase_index < size gencases
			# (gencase=:{gc_body = GCB_FunIndex icl_index}, gencases) = gencases ! [gencase_index]
			# dcl_index = function_conversion_table.[icl_index] 
			# gencase = { gencase & gc_body = GCB_FunIndex dcl_index }
			# gencases = { gencases & [gencase_index] = gencase } 
			= renumber (inc gencase_index) gencases
			= gencases	

renumber_icl_definitions_as_dcl_definitions :: !(Optional {{#Int}}) !{#Int} IndexRange !Int ![Declaration] !*{#DclModule} !*CommonDefs !*{#FunDef}
																					 	-> (![Declaration],!.{#DclModule},!.CommonDefs,!*{#FunDef})
renumber_icl_definitions_as_dcl_definitions No icl_sizes icl_global_function_range main_dcl_module_n icl_decl_symbols modules cdefs fun_defs
	= (icl_decl_symbols,modules,cdefs,fun_defs)
renumber_icl_definitions_as_dcl_definitions (Yes icl_to_dcl_index_table) icl_sizes icl_global_function_range main_dcl_module_n icl_decl_symbols modules cdefs fun_defs
	# (size_icl_functions,fun_defs) = usize fun_defs
	# icl_sizes = {{icl_sizes.[i] \\ i<-[0..cMacroDefs-1]} & [cFunctionDefs]=size_icl_functions}
	# (icl_decl_symbols,cdefs) = renumber_icl_decl_symbols icl_decl_symbols cdefs
		with
			renumber_icl_decl_symbols [] cdefs
				= ([],cdefs)
			renumber_icl_decl_symbols [icl_decl_symbol : icl_decl_symbols] cdefs
				# (icl_decl_symbol,cdefs) = renumber_icl_decl_symbol icl_decl_symbol cdefs
				# (icl_decl_symbols,cdefs) = renumber_icl_decl_symbols icl_decl_symbols cdefs
				= ([icl_decl_symbol : icl_decl_symbols],cdefs)
				where
					renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Type, decl_index}) cdefs
						# (type_def,cdefs) = cdefs!com_type_defs.[decl_index]
						# type_def = renumber_type_def type_def
						# cdefs={cdefs & com_type_defs.[decl_index]=type_def}
						= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cTypeDefs,decl_index]},cdefs)
						where
							renumber_type_def td=:{td_rhs = AlgType conses}
								# conses = [{cons & ds_index=icl_to_dcl_index_table.[cConstructorDefs,cons.ds_index]} \\ cons <- conses]
								= { td & td_rhs = AlgType conses}
							renumber_type_def td=:{td_rhs = RecordType rt=:{rt_constructor,rt_fields}}
								# rt_constructor = {rt_constructor & ds_index=icl_to_dcl_index_table.[cConstructorDefs,rt_constructor.ds_index]}
								# rt_fields = {{field & fs_index=icl_to_dcl_index_table.[cSelectorDefs,field.fs_index]} \\ field <-: rt_fields}
								= {td & td_rhs=RecordType {rt_constructor=rt_constructor,rt_fields=rt_fields}}
							renumber_type_def td
								= td
					renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Constructor, decl_index}) cdefs
						= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cConstructorDefs,decl_index]},cdefs)
					renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Field _, decl_index}) cdefs
						= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cSelectorDefs,decl_index]},cdefs)
					renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Member, decl_index}) cdefs
						= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cMemberDefs,decl_index]},cdefs)
					renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Class, decl_index}) cdefs
						# (class_def,cdefs) = cdefs!com_class_defs.[decl_index]
						# class_members = {{class_member & ds_index=icl_to_dcl_index_table.[cMemberDefs,class_member.ds_index]} \\ class_member <-: class_def.class_members}
						# class_def = {class_def & class_members=class_members}
						# cdefs = {cdefs & com_class_defs.[decl_index] =class_def}
						= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cClassDefs,decl_index]},cdefs)
					renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Instance _, decl_index}) cdefs
						= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cInstanceDefs,decl_index]},cdefs)
					renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Generic, decl_index}) cdefs
						= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cGenericDefs,decl_index]},cdefs)
					renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_GenericCase, decl_index}) cdefs
						= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cGenericCaseDefs,decl_index]},cdefs)
							//---> ("renumber generic case", icl_decl_symbol.decl_ident, decl_index, icl_to_dcl_index_table.[cGenericCaseDefs,decl_index])		
					renumber_icl_decl_symbol icl_decl=:(Declaration icl_decl_symbol=:{decl_kind=STE_FunctionOrMacro _, decl_index}) cdefs
//						| decl_index>=icl_global_function_range.ir_from && decl_index<icl_global_function_range.ir_to
							= (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cFunctionDefs,decl_index]},cdefs)	
//							= (icl_decl,cdefs)
					renumber_icl_decl_symbol icl_decl_symbol cdefs
						= (icl_decl_symbol,cdefs)
	# (dcl_mod,modules) = modules![main_dcl_module_n]
	# {n_dictionary_types,n_dictionary_selectors,n_dictionary_constructors}=dcl_mod.dcl_dictionary_info
	# cdefs=reorder_common_definitions cdefs
		with
			reorder_common_definitions {com_type_defs,com_cons_defs,com_selector_defs,com_class_defs,com_member_defs,com_instance_defs,com_generic_defs,com_gencase_defs}
				# dummy_ident = {id_name="",id_info=nilPtr}
				# com_type_defs=reorder_and_enlarge_array com_type_defs n_dictionary_types icl_to_dcl_index_table.[cTypeDefs]
									{td_name=dummy_ident,td_index= -1,td_arity=0,td_args=[],td_attrs=[],td_context=[],td_rhs=UnknownType,td_attribute=TA_None,td_pos=NoPos,td_used_types=[]}
				# dummy_symbol_type={st_vars=[],st_args=[],st_args_strictness=NotStrict,st_arity=0,st_result={at_attribute=TA_None,at_type=TE},st_context=[],st_attr_vars=[],st_attr_env=[]}
				# com_selector_defs=reorder_and_enlarge_array com_selector_defs n_dictionary_selectors icl_to_dcl_index_table.[cSelectorDefs]
					 				{sd_symb=dummy_ident,sd_field=dummy_ident,sd_type=dummy_symbol_type,sd_exi_vars=[],sd_field_nr=0,sd_type_index=0,sd_type_ptr=nilPtr,sd_pos=NoPos}
				# com_cons_defs=reorder_and_enlarge_array com_cons_defs n_dictionary_constructors icl_to_dcl_index_table.[cConstructorDefs]
									{cons_symb=dummy_ident,cons_type=dummy_symbol_type,cons_arg_vars=[],cons_priority=NoPrio,cons_index= -1,cons_type_index= -1,cons_exi_vars=[],cons_type_ptr=nilPtr,cons_pos=NoPos}					
				# com_class_defs=reorder_array com_class_defs icl_to_dcl_index_table.[cClassDefs]
				# com_member_defs=reorder_array com_member_defs icl_to_dcl_index_table.[cMemberDefs]
				# com_instance_defs=reorder_array com_instance_defs icl_to_dcl_index_table.[cInstanceDefs]
				# com_generic_defs=reorder_array com_generic_defs icl_to_dcl_index_table.[cGenericDefs]
				# com_gencase_defs=reorder_array com_gencase_defs icl_to_dcl_index_table.[cGenericCaseDefs]				
				= {
					com_type_defs=com_type_defs,com_cons_defs=com_cons_defs,com_selector_defs=com_selector_defs,
					com_class_defs=com_class_defs,com_member_defs=com_member_defs,com_instance_defs=com_instance_defs,
					com_generic_defs=com_generic_defs,com_gencase_defs=com_gencase_defs
				  }
	# fun_defs = reorder_array fun_defs icl_to_dcl_index_table.[cFunctionDefs]
	= (icl_decl_symbols,modules,cdefs,fun_defs)
	where
		reorder_array array index_array
			# new_array={e\\e<-:array}
			= {new_array & [index_array.[i]]=e \\ e<-:array & i<-[0..]}

		reorder_and_enlarge_array array n_extra_elements index_array dummy_element
			# new_array=createArray (size array+n_extra_elements) dummy_element
			= {new_array & [index_array.[i]] = e \\ e<-:array & i<-[0..]}

combineDclAndIclModule ::			 ModuleKind *{#DclModule}  [Declaration] (CollectedDefinitions a b)  *{#Int}   *CheckState
	-> (!CopiedDefinitions,!Optional {#{#Int}},!*{#DclModule},![Declaration],!CollectedDefinitions a b, !*{#Int}, !*CheckState);
combineDclAndIclModule MK_Main modules icl_decl_symbols icl_definitions icl_sizes cs
	= ({ copied_type_defs = {}, copied_class_defs = {}, copied_generic_defs = {}}, No, modules, icl_decl_symbols, icl_definitions, icl_sizes, cs)
combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs
	#! main_dcl_module_n=cs.cs_x.x_main_dcl_module_n
	# (dcl_mod=:{dcl_declared={dcls_local},dcl_macros, dcl_sizes, dcl_common}, modules) =  modules![main_dcl_module_n]

	  cs = addGlobalDefinitionsToSymbolTable icl_decl_symbols cs

	  (moved_dcl_defs,dcl_cons_and_member_defs,conversion_table, icl_sizes, icl_decl_symbols, cs)
			= foldSt (add_to_conversion_table dcl_macros.ir_from dcl_common) dcls_local ([],[],{ createArray size NoIndex \\ size <-: dcl_sizes }, icl_sizes, icl_decl_symbols, cs)
	  (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, (cop_td_indexes, cop_cd_indexes, cop_gd_indexes), conversion_table, icl_sizes, icl_decl_symbols, cs)
			= foldSt (add_dcl_definition dcl_common) moved_dcl_defs ([], [], [], [], [], [], ([], [],[]), conversion_table, icl_sizes, icl_decl_symbols, cs)
	  (new_cons_defs,new_member_defs,conversion_table,icl_sizes,icl_dec