No commit message

No commit message

backend/backendconvert.icl

@@ -1155,8 +1155,8 @@ adjustArrayFunctions array_first_instance_indices predefs main_dcl_module_n func
 				=	foldStateA (adjustStdArrayInstance arrayClassIndex arrayInfo) instances
 			where
 				adjustStdArrayInstance :: Index AdjustStdArrayInfo ClassInstance -> BackEnder
-				adjustStdArrayInstance arrayClassIndex arrayInfo=:{asai_moduleIndex} instance`=:{ins_class}
-					| ins_class.glob_object.ds_index == arrayClassIndex && ins_class.glob_module == asai_moduleIndex
+				adjustStdArrayInstance arrayClassIndex arrayInfo=:{asai_moduleIndex} instance`=:{ins_class_index}
+					| ins_class_index.gi_index == arrayClassIndex && ins_class_index.gi_module == asai_moduleIndex
 						=	adjustArrayClassInstance arrayInfo instance`
 					// otherwise
 						=	identity

frontend/analtypes.icl

@@ -615,7 +615,7 @@ emptyIdent name :== { id_name = name, id_info = nilPtr }
 newKindVariables td_args (type_var_heap, as_kind_heap)
 	= mapSt new_kind td_args (type_var_heap, as_kind_heap)
 where
-	new_kind :: ATypeVar *(*Heap TypeVarInfo,*Heap KindInfo) -> (!.TypeKind,!(!.Heap TypeVarInfo,!.Heap KindInfo));
+	new_kind :: ATypeVar *(*TypeVarHeap,*KindHeap) -> (!.TypeKind,!(!*TypeVarHeap,!*KindHeap));
 	new_kind {atv_variable={tv_info_ptr}} (type_var_heap, kind_heap)
 		# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
 		= (KindVar kind_info_ptr, (type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr)))
@@ -1018,11 +1018,12 @@ where
 			= check_kinds_of_class_instances common_defs (inc instance_index) instance_defs class_infos as
 	where	
 		check_kinds_of_class_instance :: !{#CommonDefs} !ClassInstance  !*ClassDefInfos !*AnalyseState -> (!*ClassDefInfos, !*AnalyseState)
-		check_kinds_of_class_instance common_defs {ins_class,ins_ident,ins_pos,ins_type={it_vars,it_types,it_context}} class_infos
+		check_kinds_of_class_instance common_defs {ins_class_index,ins_class_ident={ci_ident,ci_arity},ins_ident,ins_pos,ins_type={it_vars,it_types,it_context}} class_infos
 					as=:{as_type_var_heap,as_kind_heap,as_error}
 			# as_error = pushErrorAdmin (newPosition ins_ident ins_pos) as_error
 			  (as_type_var_heap, as_kind_heap) = bindFreshKindVariablesToTypeVars it_vars as_type_var_heap as_kind_heap
 			  as = { as & as_type_var_heap = as_type_var_heap, as_kind_heap = as_kind_heap, as_error = as_error }
+			  ins_class = {glob_module=ins_class_index.gi_module,glob_object={ds_index=ins_class_index.gi_index,ds_ident=ci_ident,ds_arity=ci_arity}}
 			  context = {tc_class = TCClass ins_class, tc_types = it_types, tc_var = nilPtr}
 			  (class_infos, as) = determine_kinds_of_type_contexts common_defs [context : it_context] class_infos as
 			= (class_infos, { as & as_error = popErrorAdmin as.as_error})

frontend/check.icl

@@ -175,14 +175,12 @@ where
 	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
+			  (instance_def, is, type_heaps, cs) = check_instance instance_def mod_index 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_class={glob_object = class_ident =: {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}
+	check_instance :: !ClassInstance !Index !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
+	check_instance ins=:{ins_class_ident={ci_ident={id_name,id_info}},ins_pos,ins_ident} module_index is 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
@@ -198,19 +196,17 @@ where
 	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_class={glob_object = class_ident =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident}
+			ins=:{ins_class_ident=ins_class_ident=:{ci_ident={id_name,id_info},ci_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_ident & ds_index = class_index }, glob_module = class_mod_index}
+		| class_def.class_arity == ci_arity
+			# ins_class_index = {gi_index = class_index, gi_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
+			  		= checkInstanceType module_index ins_class_index ins_class_ident 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 }
-			  )
+			= ({ins & ins_class_index = ins_class_index, ins_type = ins_type, ins_specials = ins_specials}, is, type_heaps, cs)
+			# cs = {cs & cs_error = checkError id_name ("wrong arity: expected "+++toString class_def.class_arity+++" found "+++toString ci_arity) cs.cs_error}
+			= (ins, is, type_heaps, cs)
 
 checkIclInstances :: !Index !*CommonDefs !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
 	-> (![(Index,SymbolType)], !*CommonDefs, !u:{# DclModule}, !*VarHeap , !*TypeHeaps, !*CheckState)
@@ -231,25 +227,22 @@ where
 			# (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_icl_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_ident}, 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_icl_instance_members mod_index ins_class.glob_module
-			  	        	 0 class_size ins_members class_members class_ident 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 = checkErrorWithIdentPos (newPosition class_ident ins_pos) "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_class_instance {ins_pos,ins_class_index,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_ident}, class_defs, modules) = getClassDef ins_class_index 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_icl_instance_members mod_index ins_class_index.gi_module
+		  	        	 0 class_size ins_members class_members class_ident 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)
+			# cs = { cs & cs_error = checkErrorWithIdentPos (newPosition class_ident ins_pos) "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_icl_instance_members :: !Index !Index !Int !Int !{#ClassInstanceMember} !{#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_icl_instance_members module_index member_mod_index mem_offset class_size ins_members class_members
 				class_ident 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
@@ -272,13 +265,13 @@ where
 				= check_icl_instance_members module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_ident ins_pos ins_type
 						[ (ins_member.cim_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]
+getClassDef :: !GlobalIndex !Int !u:{#ClassDef} !v:{#DclModule} -> (!ClassDef,!u:{#ClassDef},!v:{#DclModule})
+getClassDef {gi_module,gi_index} mod_index class_defs modules
+	| gi_module == mod_index
+		# (class_def, class_defs) = class_defs![gi_index]
 		= (class_def, class_defs, modules)
-		# (dcl_mod, modules) = modules![glob_module]
-		= (dcl_mod.dcl_common.com_class_defs.[ds_index], class_defs, modules)
+		# (dcl_mod, modules) = modules![gi_module]
+		= (dcl_mod.dcl_common.com_class_defs.[gi_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
@@ -480,11 +473,11 @@ where
 	determine_types_of_dcl_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_ident, class_members}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules
+			# (instance_def=:{ins_class_index,ins_pos,ins_type,ins_specials}, instance_defs) = instance_defs![inst_index]
+			# ({class_ident, class_members}, class_defs, modules) = getClassDef ins_class_index mod_index class_defs modules
 			  class_size = size class_members
 			  (ins_members, memb_inst_defs1, member_defs, modules, type_heaps, var_heap, error)
-			  		= determine_dcl_instance_symbols_and_types x_main_dcl_module_n next_mem_inst_index 0 mod_index ins_class.glob_module class_size class_members
+			  		= determine_dcl_instance_symbols_and_types x_main_dcl_module_n next_mem_inst_index 0 mod_index ins_class_index.gi_module class_size class_members
 			  				ins_type ins_specials class_ident 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)
@@ -2444,8 +2437,8 @@ check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports m
 			adjust_instance_types_of_array_functions :: !Index !{#.Index} !Int !*(!u:{# ClassInstance},!*{# FunDef},!v:{#PredefinedSymbol})
 					-> (!u:{# ClassInstance},!*{# FunDef},!v:{#PredefinedSymbol})
 			adjust_instance_types_of_array_functions array_class_index offset_table inst_index (class_instances, fun_defs, predef_symbols)
-				# ({ins_class={glob_module,glob_object={ds_index}},ins_type,ins_members}, class_instances) = class_instances![inst_index]
-				| glob_module == main_dcl_module_n && ds_index == array_class_index && elemTypeIsStrict ins_type.it_types predef_symbols
+				# ({ins_class_index={gi_module,gi_index},ins_type,ins_members}, class_instances) = class_instances![inst_index]
+				| gi_module == main_dcl_module_n && gi_index == array_class_index && elemTypeIsStrict ins_type.it_types predef_symbols
 					# fun_defs = iFoldSt (make_instance_strict ins_members offset_table) 0 (size ins_members) fun_defs
 					= (class_instances, fun_defs, predef_symbols)
 					= (class_instances, fun_defs, predef_symbols)
@@ -2455,7 +2448,7 @@ check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports m
 				# {cim_index} = instances.[ins_offset]
 				  (inst_def, instance_defs) = instance_defs![cim_index]
 				  (Yes symbol_type) = inst_def.fun_type
-				= {instance_defs & [cim_index] = {inst_def & fun_type = Yes (makeElemTypeOfArrayFunctionStrict symbol_type ins_offset offset_table)}}
+				= { instance_defs & [cim_index] = { inst_def & fun_type = Yes (makeElemTypeOfArrayFunctionStrict symbol_type ins_offset offset_table) } }
 
 		checkSpecifiedInstanceType (index_of_member_fun, derived_symbol_type) (icl_functions, type_heaps, cs_error)
 			# ({fun_type, fun_pos, fun_ident}, icl_functions) = icl_functions![index_of_member_fun]
@@ -2936,7 +2929,7 @@ checkInstancesOfDclModule mod_index	(nr_of_dcl_functions_and_instances, nr_of_dc
 		
 	   dcl_modules = { dcl_modules & [mod_index] = dcl_mod }
 	= (dcl_modules, heaps, cs)
-  where   
+  where
 	adjust_instance_types_of_array_functions_in_std_array_dcl array_mod_index class_members class_instances fun_types cs=:{cs_predef_symbols}
 		#! nr_of_instances = size class_instances
 		# ({pds_def}, cs_predef_symbols) = cs_predef_symbols![PD_ArrayClass]
@@ -2949,8 +2942,8 @@ checkInstancesOfDclModule mod_index	(nr_of_dcl_functions_and_instances, nr_of_dc
 		adjust_instance_types_of_array_functions :: .Index !Index !{#.Index} !Int !*(!u:{# ClassInstance},!*{# FunType},!v:{#PredefinedSymbol})
 			 -> (!u:{# ClassInstance},!*{# FunType},!v:{#PredefinedSymbol})
 		adjust_instance_types_of_array_functions array_mod_index array_class_index offset_table inst_index (class_instances, fun_types, predef_symbols)
-			# ({ins_class={glob_module,glob_object={ds_index}},ins_type,ins_members}, class_instances) = class_instances![inst_index]
-			| glob_module == array_mod_index && ds_index == array_class_index && elemTypeIsStrict ins_type.it_types predef_symbols
+			# ({ins_class_index={gi_module,gi_index},ins_type,ins_members}, class_instances) = class_instances![inst_index]
+			| gi_module == array_mod_index && gi_index == array_class_index && elemTypeIsStrict ins_type.it_types predef_symbols
 				# fun_types = iFoldSt (make_instance_strict ins_members offset_table) 0 (size ins_members) fun_types
 				= (class_instances, fun_types, predef_symbols)
 				= (class_instances, fun_types, predef_symbols)
@@ -3153,9 +3146,8 @@ where
 				= foldlArraySt (count_members_of_instance mod_index) com_instance_defs (0, com_class_defs, modules)
 		= sum
 
-	count_members_of_instance mod_index {ins_class} (sum, com_class_defs, modules)
-		# ({class_members}, com_class_defs, modules)
-			= getClassDef ins_class mod_index com_class_defs modules
+	count_members_of_instance mod_index {ins_class_index} (sum, com_class_defs, modules)
+		# ({class_members}, com_class_defs, modules) = getClassDef ins_class_index mod_index com_class_defs modules
  		= (size class_members + sum, com_class_defs, modules)
 
 adjustPredefSymbol predef_index mod_index symb_kind cs=:{cs_symbol_table,cs_error}

frontend/checktypes.dcl

@@ -11,8 +11,8 @@ checkFunctionType :: !Index !SymbolType !FunSpecials !u:{#CheckedTypeDef} !v:{#C
 checkMemberType :: !Index !SymbolType !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
 	-> (!SymbolType, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
 
-checkInstanceType :: !Index !(Global DefinedSymbol) !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
-	-> (!InstanceType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
+checkInstanceType :: !Index !GlobalIndex !ClassIdent !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+												 -> (!InstanceType,!Specials,!u:{# CheckedTypeDef},!v:{# ClassDef},!u:{# DclModule},!*TypeHeaps,!*CheckState)
 
 checkSuperClasses :: ![TypeVar] ![TypeContext] !Index !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
 	-> (![TypeVar], ![TypeContext], !u:{#CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)

frontend/checktypes.icl

@@ -772,9 +772,9 @@ checkOpenType mod_index scope dem_attr type cot_state
 checkOpenATypes mod_index scope types cot_state
 	= mapSt (checkOpenAType mod_index scope DAK_None) types cot_state
 
-checkInstanceType :: !Index !(Global DefinedSymbol) !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
-	-> (!InstanceType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
-checkInstanceType mod_index ins_class it=:{it_types,it_context} specials type_defs class_defs modules heaps cs
+checkInstanceType :: !Index !GlobalIndex !ClassIdent !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
+												 -> (!InstanceType,!Specials,!u:{# CheckedTypeDef},!v:{# ClassDef},!u:{# DclModule},!*TypeHeaps,!*CheckState)
+checkInstanceType mod_index ins_class_index ins_class_ident it=:{it_types,it_context} specials type_defs class_defs modules heaps cs
 	# cs_error = check_fully_polymorphity it_types it_context cs.cs_error
 	  ots = { ots_type_defs = type_defs, ots_modules = modules }
 	  oti = { oti_heaps = heaps, oti_all_vars = [], oti_all_attrs = [], oti_global_vars= [] }
@@ -783,7 +783,7 @@ checkInstanceType mod_index ins_class it=:{it_types,it_context} specials type_de
 	  (heaps, cs) = check_linearity_of_type_vars it_vars oti.oti_heaps cs
 	  oti = { oti &  oti_all_vars = [], oti_all_attrs = [], oti_heaps = heaps }
 	  (it_context, type_defs, class_defs, modules, heaps, cs) = checkTypeContexts it_context mod_index class_defs ots oti cs
-	  cs_error = foldSt (compare_context_and_instance_types ins_class it_types) it_context cs.cs_error
+	  cs_error = foldSt (compare_context_and_instance_types ins_class_index ins_class_ident it_types) it_context cs.cs_error
 	  (specials, cs) = checkSpecialTypeVars specials { cs & cs_error = cs_error }
 	  cs_symbol_table = removeVariablesFromSymbolTable cGlobalScope it_vars cs.cs_symbol_table
 	  cs_symbol_table = removeAttributesFromSymbolTable it_attr_vars cs_symbol_table
@@ -809,15 +809,15 @@ checkInstanceType mod_index ins_class it=:{it_types,it_context} specials type_de
 				= (th_vars, checkError tv_ident ": this type variable occurs more than once in an instance type" error)
 				= (th_vars, error)
 
-	compare_context_and_instance_types ins_class it_types {tc_class=TCGeneric _, tc_types} cs_error
+	compare_context_and_instance_types ins_class_index ins_class_ident it_types {tc_class=TCGeneric _, tc_types} cs_error
 		= cs_error
-	compare_context_and_instance_types ins_class it_types {tc_class=TCClass clazz, tc_types} cs_error
-		| ins_class<>clazz
+	compare_context_and_instance_types ins_class_index ins_class_ident it_types {tc_class=TCClass clazz, tc_types} cs_error
+		| ins_class_index.gi_module<>clazz.glob_module || ins_class_index.gi_index<>clazz.glob_object.ds_index
 			= cs_error
 		# are_equal
 				= fold2St compare_context_and_instance_type it_types tc_types True
 		| are_equal
-			= checkError ins_class.glob_object.ds_ident "context restriction equals instance type" cs_error
+			= checkError ins_class_ident.ci_ident "context restriction equals instance type" cs_error
 		= cs_error
 	  where
 		compare_context_and_instance_type (TA {type_index=ti1} _) (TA {type_index=ti2} _) are_equal_accu

frontend/explicitimports.icl

@@ -600,9 +600,9 @@ instance check_completeness ClassDef where
 		= check_completeness class_context cci ccs
 		
 instance check_completeness ClassInstance where
-	check_completeness {ins_class={glob_module,glob_object={ds_ident,ds_index}}, ins_type} cci ccs
+	check_completeness {ins_class_index={gi_module,gi_index},ins_class_ident={ci_ident},ins_type} cci ccs
 		= check_completeness ins_type cci
-		  (check_whether_ident_is_imported ds_ident glob_module ds_index STE_Class cci ccs)
+		  (check_whether_ident_is_imported ci_ident gi_module gi_index STE_Class cci ccs)
 
 instance check_completeness ConsDef
   where

frontend/generics1.icl

@@ -273,8 +273,8 @@ buildGenericTypeRep type_index funs_and_groups
 		, hp_var_heap = gs_varh
 		, hp_generic_heap = gs_genh
 		, hp_type_heaps = { th_vars = gs_tvarh, th_attrs = gs_avarh }
-		}	
-		
+		}
+
 	# (type_def, gs_modules) = gs_modules![type_index.gi_module].com_type_defs.[type_index.gi_index]
 
 	# (type_info, cons_infos, funs_and_groups, gs_modules, heaps, gs_error)
@@ -1381,7 +1381,7 @@ buildMemberType gen_def=:{gen_ident,gen_pos,gen_type,gen_vars} kind class_var gs
 	#! th = {th_vars = gs.gs_tvarh, th_attrs = gs.gs_avarh}
 	#! (kind_indexed_st, gatvs, th, gs_error) 
 		= buildKindIndexedType gen_type gen_vars kind gen_ident gen_pos th gs.gs_error
-		
+
 	#! (member_st, th, gs_error) 
 		= replace_generic_vars_with_class_var kind_indexed_st gatvs th gs_error
 
@@ -1839,9 +1839,9 @@ where
 		build_shorthand_class_instance :: TypeKind Int Ident Position DefinedSymbol InstanceType !(!Int,![ClassInstance]) -> (!Int,![ClassInstance])
 		build_shorthand_class_instance this_kind class_index gc_ident gc_pos {ds_ident,ds_arity,ds_index} ins_type (ins_index, instances)
 			#! class_ident = genericIdentToClassIdent gc_ident.id_name this_kind
-			#! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_ident}
 			#! ins = 
-			 	{	ins_class 	= {glob_module=gs_main_module, glob_object=class_ds}
+			 	{	ins_class_index = {gi_module=gs_main_module, gi_index=class_index}
+			 	,	ins_class_ident = {ci_ident=class_ident, ci_arity=1}
 				,	ins_ident 	= class_ident
 				,	ins_type 	= ins_type
 				,	ins_members	= {{cim_ident=ds_ident,cim_arity=ds_arity,cim_index=ds_index}}
@@ -1919,7 +1919,8 @@ where
 		# class_ident = genericIdentToClassIdent gc_ident.id_name gc_kind
 		# class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_ident}
 		#! ins =
-		 	{	ins_class 	= {glob_module=gs_main_module, glob_object=class_ds}
+		 	{	ins_class_index = {gi_module=gs_main_module, gi_index=class_index}
+		 	,	ins_class_ident = {ci_ident=class_ident, ci_arity=1}
 			,	ins_ident 	= class_ident
 			,	ins_type 	= ins_type
 			,	ins_members	= {class_instance_member}
@@ -3836,15 +3837,8 @@ curryGenericArgType1 :: !SymbolType !String !*TypeHeaps
 	-> (!SymbolType, !*TypeHeaps)
 curryGenericArgType1  st=:{st_args, st_result, st_attr_env, st_attr_vars} attr_var_name th=:{th_attrs}
 	# (atype, attr_vars, av_num, th_attrs) = curry st_args st_result 1 th_attrs
-	# curried_st = 
-		{ st 
-		& st_args = []
-		, st_arity = 0
-		, st_result = atype
-		, st_attr_vars = attr_vars
-		}
+	# curried_st = {st & st_args = [], st_arity = 0, st_result = atype, st_attr_vars = attr_vars}
 	= (curried_st, {th & th_attrs = th_attrs})	
-		//---> ("curryGenericArgType", st, curried_st)
 where
 	// outermost closure gets TA_Multi attribute
 	curry [] res av_num th_attrs
@@ -3868,7 +3862,6 @@ where
 clearType t th 
 	= foldType clear_type clear_atype t th
 where
-
 	clear_type (TV tv) th = clear_type_var tv th	
 	clear_type (GTV tv) th = clear_type_var tv th
 	clear_type (CV tv :@: _) th = clear_type_var tv th
@@ -3876,7 +3869,6 @@ where
 		#! th = foldSt clear_attr [atv_attribute \\ {atv_attribute} <- atvs] th
 		#! th = foldSt clear_type_var [atv_variable \\ {atv_variable} <- atvs] th
 		= th
-		 	
 	clear_type _ th = th
 
 	clear_atype {at_attribute} th 
@@ -3888,6 +3880,7 @@ where
 		
 	clear_type_var {tv_info_ptr} th=:{th_vars} 
 		= {th & th_vars = writePtr tv_info_ptr TVI_Empty th_vars} 
+
 	clear_attr_var {av_info_ptr} th=:{th_attrs} 
 		= {th & th_attrs = writePtr av_info_ptr AVI_Empty th_attrs} 
 
@@ -3953,7 +3946,6 @@ collectAttrVars type th
 collectAttrsOfTypeVars :: ![TypeVar] type !*TypeHeaps -> (![ATypeVar], !*TypeHeaps) | foldType type
 collectAttrsOfTypeVars tvs type th
 	#! (th=:{th_vars}) = clearType type th
-		//---> ("collectAttrsOfTypeVars called for", tvs)
 	
 	# th_vars = foldSt (\{tv_info_ptr} h->writePtr tv_info_ptr TVI_Used h) tvs th_vars 
 	
@@ -3963,7 +3955,6 @@ collectAttrsOfTypeVars tvs type th
 
  	#! th = clearType type {th & th_vars= th_vars}
 	= (atvs, th)
-		//---> ("collectAttrsOfTypeVars returns", atvs)
 where
 	on_type type st = st
 

frontend/syntax.dcl

@@ -439,7 +439,8 @@ cNameLocationDependent :== True
 	}
 
 ::	ClassInstance =
- 	{	ins_class		:: !Global DefinedSymbol
+ 	{	ins_class_index	:: !GlobalIndex
+	,	ins_class_ident	:: !ClassIdent
 	,	ins_ident		:: !Ident
 	,	ins_type		:: !InstanceType
 	,	ins_members		:: !{#ClassInstanceMember}
@@ -447,6 +448,11 @@ cNameLocationDependent :== True
 	,	ins_pos			:: !Position
 	}
 
+::	ClassIdent =
+	{	ci_ident		:: !Ident
+	,	ci_arity		:: !Int
+	}
+
 ::	ClassInstanceMember = 
 	{	cim_ident		:: !Ident
 	,	cim_arity		:: !Int		// module number if cim_index<0
@@ -1491,10 +1497,11 @@ ParsedConstructorToConsDef pc :==
 		cons_exi_vars = pc.pc_exi_vars, cons_type_ptr = nilPtr }
 
 ParsedInstanceToClassInstance pi members :==
- 	{	ins_class = {glob_object = MakeDefinedSymbol pi.pi_class NoIndex (length pi.pi_types), glob_module = NoIndex}, ins_ident = pi.pi_ident, 
- 		ins_type = { it_vars = [], it_types = pi.pi_types, it_attr_vars = [],
- 					 it_context = pi.pi_context }, 
- 		ins_members = members, ins_specials = pi.pi_specials, ins_pos = pi.pi_pos}
+	{	ins_class_index = {gi_module=NoIndex, gi_index=NoIndex},
+		ins_class_ident = {ci_ident=pi.pi_class, ci_arity=length pi.pi_types}, ins_ident = pi.pi_ident,
+		ins_type = { it_vars = [], it_types = pi.pi_types, it_attr_vars = [],
+					 it_context = pi.pi_context }, 
+		ins_members = members, ins_specials = pi.pi_specials, ins_pos = pi.pi_pos}
 
 MakeTypeDef name lhs rhs attr pos  :== 
 	{	td_ident = name, td_index = -1, td_arity = length lhs, td_args = lhs, td_attrs = [], td_attribute = attr,

frontend/syntax.icl

 implementation module syntax
 
-import StdEnv, compare_constructor // ,RWSDebug
-
-import scanner, general, Heap, typeproperties, utilities, compilerSwitches
+import StdEnv, compare_constructor
+import scanner, general, Heap, typeproperties, utilities
 import syntax
 
 instance toString Ident
@@ -722,7 +721,7 @@ where
 
 instance <<< ClassInstance
 where
-	(<<<) file {ins_class,ins_type} = file <<< ins_class <<< " :: " <<< ins_type
+	(<<<) file {ins_class_ident,ins_type} = file <<< ins_class_ident.ci_ident <<< " :: " <<< ins_type
 
 instance <<< (Optional a) | <<< a
 where

frontend/type.icl

@@ -2250,10 +2250,10 @@ typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_de
 	  ti_functions	 = {dcl_functions \\ {dcl_functions} <-: dcl_modules }	  
 
 	  class_instances = { {  IT_Empty \\ i <- [0 .. dec (size com_class_defs)] } \\ {com_class_defs} <-: ti_common_defs }
-	  state = collect_imported_instances imports ti_common_defs {} ts_error class_instances hp_type_heaps.th_vars td_infos
+	  state = collect_imported_instances imports ti_common_defs ts_error class_instances hp_type_heaps.th_vars td_infos
 	  state = collect_qualified_imported_instances icl_qualified_imports ti_common_defs state
 
-	  (_, ts_error, class_instances, th_vars, td_infos) = collect_and_check_instances (size icl_defs.com_instance_defs) ti_common_defs state
+	  (ts_error, class_instances, th_vars, td_infos) = collect_and_check_instances (size icl_defs.com_instance_defs) ti_common_defs state
 	  
 	  ts = { ts_fun_env = InitFunEnv fun_env_size, ts_var_heap = hp_var_heap, ts_expr_heap = hp_expression_heap, ts_generic_heap = hp_generic_heap, ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_cons_variables = [], ts_exis_variables = [],
 	  		 ts_type_heaps = { hp_type_heaps & th_vars = th_vars }, ts_td_infos = td_infos, ts_error = ts_error, ts_fun_defs=fun_defs }
@@ -2276,10 +2276,9 @@ typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_de
 	= (not type_error, fun_defs, array_and_list_instances, ti_common_defs, ti_functions,
 			ts_td_infos, {hp_var_heap = ts_var_heap, hp_expression_heap = ts_expr_heap, hp_type_heaps = ts_type_heaps, hp_generic_heap=ts_generic_heap },
 			predef_symbols, ts_error.ea_file, out)
-//				---> ("typeProgram", array_inst_types)
 where
-	collect_imported_instances imports common_defs dummy error class_instances type_var_heap td_infos
-		= foldlArraySt (collect_imported_instance common_defs) imports (dummy, error, class_instances, type_var_heap, td_infos)
+	collect_imported_instances imports common_defs error class_instances type_var_heap td_infos
+		= foldlArraySt (collect_imported_instance common_defs) imports (error, class_instances, type_var_heap, td_infos)
 
 	collect_qualified_imported_instances icl_qualified_imports common_defs state
 		= foldSt (\ (declarations,_,_) state -> foldSt (collect_imported_instance common_defs) declarations state)
@@ -2293,16 +2292,14 @@ where
 	collect_and_check_instances nr_of_instances common_defs state
 		= iFoldSt (update_instances_of_class common_defs main_dcl_module_n) 0 nr_of_instances state
 
-	update_instances_of_class common_defs mod_index ins_index (dummy, error, class_instances, type_var_heap, td_infos)
-		#!{ins_class={glob_object={ds_ident={id_name}, ds_index},glob_module},ins_type={it_types},ins_pos} = common_defs.[mod_index].com_instance_defs.[ins_index]
-		  (mod_instances, class_instances) = replace class_instances glob_module dummy 
-		  (instances, mod_instances) = replace mod_instances ds_index IT_Empty
+	update_instances_of_class common_defs mod_index ins_index (error, class_instances, type_var_heap, td_infos)
+		#!{ins_class_index={gi_module,gi_index},ins_type={it_types},ins_pos} = common_defs.[mod_index].com_instance_defs.[ins_index]
+		  (instances, class_instances) = class_instances![gi_module,gi_index]
 		  (error, instances) = insert it_types ins_index mod_index common_defs error instances
-		  (_, mod_instances) = replace mod_instances ds_index instances
-		  (dummy, class_instances) = replace class_instances glob_module mod_instances
+		  class_instances = {class_instances & [gi_module,gi_index]=instances}
 		  (error, type_var_heap, td_infos)
-					= check_types_of_instances ins_pos common_defs glob_module ds_index it_types (error, type_var_heap, td_infos)
-		= (dummy, error, class_instances, type_var_heap, td_infos)
+					= check_types_of_instances ins_pos common_defs gi_module gi_index it_types (error, type_var_heap, td_infos)
+		= (error, class_instances, type_var_heap, td_infos)
 	where
 		insert ::  ![Type] !Index !Index !{# CommonDefs } !*ErrorAdmin !*InstanceTree -> (!*ErrorAdmin, !*InstanceTree)
 		insert ins_types new_ins_index new_ins_module modules error IT_Empty