buf fix (dictionary types in dcl modules)

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@91 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

4 files changed, 17 insertions, 11 deletions

diff --git a/frontend/analtypes.icl b/frontend/analtypes.icl
index 2793a43..692e317 100644
--- a/frontend/analtypes.icl
+++ b/frontend/analtypes.icl
@@ -308,9 +308,9 @@ analTypeDef modules type_module type_index as=:{as_error,as_heaps,as_kind_heap,a
 	  (is_abs_type, abs_type_properties) = is_abstract_type td_rhs
 	| is_abs_type
 		# (tdi, as_td_infos) = as_td_infos![type_module].[type_index]
-		= (cMAXINT, ({con_top_var_binds = [], con_var_binds = [] }, 
-				{ as & as_td_infos = { as_td_infos & [type_module].[type_index] = { tdi & tdi_kinds = [ KindConst \\ _ <- td_args ], tdi_group_vars = [ i \\ _ <- td_args & i <- [0..]],
-																						  tdi_properties = abs_type_properties }}}))
+		  tdi = {	tdi & tdi_kinds = [ KindConst \\ _ <- td_args ], tdi_group = [{glob_module = type_module, glob_object = type_index}], 
+		  			tdi_group_vars = [ i \\ _ <- td_args & i <- [0..]], tdi_properties = abs_type_properties }
+		= (cMAXINT, ({con_top_var_binds = [], con_var_binds = [] }, { as & as_td_infos = { as_td_infos & [type_module].[type_index] = tdi}}))
 		# position = newPosition td_name td_pos
 		  as_error = pushErrorAdmin position as_error
 		  (tdi_kinds, (th_vars, as_kind_heap)) = newKindVariables td_args (as_heaps.th_vars, as_kind_heap)
diff --git a/frontend/analunitypes.icl b/frontend/analunitypes.icl
index fec92d1..cdb3e5c 100644
--- a/frontend/analunitypes.icl
+++ b/frontend/analunitypes.icl
@@ -24,20 +24,21 @@ set_sign_in_sign_class {pos_sign,neg_sign} index {sc_pos_vect,sc_neg_vect}
 typeProperties :: !Index  !Index ![SignClassification] ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
 	-> (!TypeSymbProperties, !*TypeVarHeap, !*TypeDefInfos)
 typeProperties type_index module_index hio_signs hio_props defs type_var_heap td_infos
-	# {td_args} = defs.[module_index].com_type_defs.[type_index]
+	# {td_args, td_name} = defs.[module_index].com_type_defs.[type_index]
 	  (td_info, td_infos) = td_infos![module_index].[type_index]
 	  (tsp_sign, type_var_heap, td_infos) = determineSignClassOfTypeDef type_index module_index td_args td_info hio_signs defs type_var_heap td_infos
 	  (tsp_propagation, type_var_heap, td_infos) = determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos
 	  tsp_coercible = (td_info.tdi_properties bitand cIsNonCoercible) == 0
 	= ({tsp_sign = tsp_sign, tsp_propagation = tsp_propagation, tsp_coercible = tsp_coercible }, type_var_heap, td_infos)
-
+//		---> ("typeProperties", td_name, tsp_sign, tsp_propagation)
+		
 signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
 	-> (!SignClassification, !*TypeVarHeap, !*TypeDefInfos)
 signClassification type_index module_index hio_signs defs type_var_heap td_infos
-	# {td_args} = defs.[module_index].com_type_defs.[type_index]
+	# {td_name,td_args} = defs.[module_index].com_type_defs.[type_index]
 	  (td_info, td_infos) = td_infos![module_index].[type_index]
 	= determineSignClassOfTypeDef type_index module_index td_args td_info hio_signs defs type_var_heap td_infos
-
+//		---> ("signClassification", td_name)
 removeTopClasses [cv : cvs] [tc : tcs] 
 	| isATopConsVar cv
 		= removeTopClasses cvs tcs
@@ -54,12 +55,15 @@ determineSignClassOfTypeDef type_index module_index td_args {tdi_classification,
 	= case result of
 		Yes {ts_type_sign}
 			-> (ts_type_sign, type_var_heap, td_infos)
+//					---> ("determineSignClassOfTypeDef1", ts_type_sign)
+
 		No
 			# type_var_heap = bind_type_vars_to_signs td_args tdi_group_vars tdi_cons_vars hio_signs type_var_heap
 			  (sign_class, type_var_heap, td_infos)
 			  		= newSignClassOfTypeDefGroup tdi_group_nr { glob_module = module_index, glob_object = type_index}
 						tdi_group hio_signs ci type_var_heap td_infos
 			-> (sign_class, foldSt restore_binds_of_type_var td_args type_var_heap, td_infos)
+//					---> ("determineSignClassOfTypeDef2", sign_class)
 
 where
 	bind_type_vars_to_signs [{atv_variable={tv_info_ptr}}: tvs] [gv : gvs] cons_vars hio_signs type_var_heap
@@ -237,7 +241,7 @@ determinePropClassOfTypeDef type_index module_index td_args {tdi_classification,
 			hio_props ci type_var_heap td_infos
 	# hio_props = removeTopClasses tdi_cons_vars hio_props
 	  result = retrievePropClassification hio_props tdi_classification
-					// ---> (td_args, tdi_kinds, tdi_group_vars)
+//					---> (td_args, tdi_kinds, tdi_group_vars)
 	= case result of
 		Yes {ts_type_prop}
 			-> (ts_type_prop, type_var_heap, td_infos)
diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl
index 49651fb..4802ced 100644
--- a/frontend/checktypes.icl
+++ b/frontend/checktypes.icl
@@ -226,7 +226,7 @@ decodeTopConsVar cv		:== ~(inc cv)
 
 checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:{cs_error}
 	#! type_def = ts_type_defs.[type_index]
-	# {td_name,td_pos,td_args,td_attribute,td_properties} = type_def
+	# {td_name,td_pos,td_args,td_attribute} = type_def
 	  position = newPosition td_name td_pos
 	  cs_error = pushErrorAdmin position cs_error
 	  (td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_name.id_name ti_type_heaps.th_attrs
diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl
index e2a4ea8..cb0ddcd 100644
--- a/frontend/convertcases.icl
+++ b/frontend/convertcases.icl
@@ -527,10 +527,12 @@ where
 convertDclModule :: !{# DclModule} !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
 	-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
 convertDclModule dcl_mods common_defs imported_types imported_conses var_heap type_heaps
-	# {dcl_functions,dcl_common={com_type_defs,com_cons_defs,com_selector_defs},dcl_conversions} = dcl_mods.[cIclModIndex]
+	# {dcl_functions,dcl_common=dcl_common=:{com_type_defs,com_cons_defs,com_selector_defs},dcl_conversions} = dcl_mods.[cIclModIndex]
 	= case dcl_conversions of
 		Yes conversion_table
 			# (icl_type_defs, imported_types) = imported_types![cIclModIndex]
+			  common_defs = { common \\ common <-: common_defs }
+			  common_defs = { common_defs & [cIclModIndex] = dcl_common }
 			  types_and_heaps = convert_dcl_functions dcl_functions common_defs ( { imported_types & [cIclModIndex] = com_type_defs }, imported_conses, var_heap, type_heaps)
 			  types_and_heaps = convertConstructorTypes com_cons_defs common_defs types_and_heaps
 			  (imported_types, imported_conses, var_heap, type_heaps) = convertSelectorTypes com_selector_defs common_defs types_and_heaps
@@ -545,7 +547,7 @@ where
 		# {ft_type, ft_type_ptr} = dcl_functions.[dcl_index]
 		  (ft_type, imported_types, imported_conses, type_heaps, var_heap) = convertSymbolType common_defs ft_type imported_types imported_conses type_heaps var_heap
 		= (imported_types, imported_conses, var_heap <:= (ft_type_ptr, VI_ExpandedType ft_type), type_heaps)
-	
+
 convertConstructorTypes cons_defs common_defs types_and_heaps
 	= iFoldSt (convert_constructor_type common_defs cons_defs) 0 (size cons_defs) types_and_heaps
 where