update derive class for deriving generic functions in class context (from iTask branch)

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

3 files changed, 26 insertions, 9 deletions

diff --git a/frontend/checktypes.dcl b/frontend/checktypes.dcl
index 07e50f7..c0adacd 100644
--- a/frontend/checktypes.dcl
+++ b/frontend/checktypes.dcl
@@ -25,4 +25,7 @@ checkDynamicTypes :: !Index ![ExprInfoPtr] !(Optional SymbolType)
 createClassDictionaries ::		  !Bool !Index !Index !Index !Index !*{#CheckedTypeDef} !*{# SelectorDef} !*{# ConsDef} !*{#ClassDef} !*{#DclModule} !*TypeVarHeap !*VarHeap !*SymbolTable
 	-> (![CheckedTypeDef],![SelectorDef],![ConsDef],!DictionaryInfo,!*{#CheckedTypeDef},!*{# SelectorDef},!*{# ConsDef},!*{#ClassDef},!*{#DclModule},!*TypeVarHeap,!*VarHeap,!*SymbolTable)
 
+createMoreClassDictionaries ::	   !Int !Index !Index !Index !Index !*{#CheckedTypeDef} !*{#SelectorDef} !*{#ConsDef} !*{#ClassDef} !*{#DclModule} !*TypeVarHeap !*VarHeap !*SymbolTable
+					-> (![CheckedTypeDef],![SelectorDef],![ConsDef],!*{#CheckedTypeDef},!*{#SelectorDef},!*{#ConsDef},!*{#ClassDef},!*{#DclModule},!*TypeVarHeap,!*VarHeap,!*SymbolTable)
+
 removeVariablesFromSymbolTable :: !Int ![TypeVar] !*SymbolTable -> *SymbolTable
diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl
index 5c88c76..393459d 100644
--- a/frontend/checktypes.icl
+++ b/frontend/checktypes.icl
@@ -1660,6 +1660,18 @@ where
 			= create_exported_icl_class_dictionaries mod_index (inc dcl_class_index) dcl_class_defs type_defs class_defs modules rev_dictionary_list indexes type_var_heap var_heap symbol_table
 			= (type_defs, class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table)
 
+createMoreClassDictionaries ::	   !Int !Index !Index !Index !Index !*{#CheckedTypeDef} !*{#SelectorDef} !*{#ConsDef} !*{#ClassDef} !*{#DclModule} !*TypeVarHeap !*VarHeap !*SymbolTable
+					-> (![CheckedTypeDef],![SelectorDef],![ConsDef],!*{#CheckedTypeDef},!*{#SelectorDef},!*{#ConsDef},!*{#ClassDef},!*{#DclModule},!*TypeVarHeap,!*VarHeap,!*SymbolTable)
+createMoreClassDictionaries first_new_class_index mod_index first_type_index first_selector_index first_cons_index type_defs selector_defs cons_defs class_defs modules type_var_heap var_heap symbol_table
+	# (class_defs,last_type_index_plus1) = number_icl_class_dictionaries first_new_class_index class_defs first_type_index
+	# indexes = { index_type = first_type_index, index_cons= first_cons_index, index_selector = first_selector_index }
+	# (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table)
+		= create_icl_class_dictionaries mod_index first_new_class_index last_type_index_plus1 first_type_index class_defs modules [] indexes type_var_heap var_heap symbol_table
+	# (size_type_defs,type_defs) = usize type_defs
+	  (type_def_list, sel_def_list, cons_def_list, selector_defs, cons_defs, symbol_table)
+	  	= collect_type_defs_in_icl_module size_type_defs rev_dictionary_list selector_defs cons_defs symbol_table
+	= (type_def_list, sel_def_list, cons_def_list, type_defs, selector_defs, cons_defs, class_defs, modules, type_var_heap, var_heap, symbol_table)
+
 number_icl_class_dictionaries class_index class_defs index_type
 	| class_index < size class_defs
 		| class_defs.[class_index].class_dictionary.ds_index==NoIndex
diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index 114d8fe..dcdb446 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -6,7 +6,7 @@ implementation module generics1
 
 import StdEnv,compare_types
 import check
-from checktypes import createClassDictionaries
+from checktypes import createMoreClassDictionaries
 from transform import ::Group
 import genericsupport
 
@@ -1259,15 +1259,17 @@ buildClasses gs=:{gs_main_module}
 	#! ((classes, members, new_num_classes, new_num_members), gs)
 		= build_modules 0 ([], [], num_classes, num_members) gs
 
+	# first_new_class_index = size com_class_defs
+
 	// obtain common definitions again because com_gencase_defs are updated 
 	#! (common_defs,gs) = gs!gs_modules.[gs_main_module]
 	# common_defs = {common_defs & com_class_defs = arrayPlusRevList com_class_defs classes
 								 , com_member_defs = arrayPlusRevList com_member_defs members}
 
 	#! (common_defs, gs)
-		= build_class_dictionaries common_defs gs
-
-	= {gs & gs_modules.[gs_main_module] = common_defs}
+		= build_class_dictionaries first_new_class_index common_defs gs
+	
+	= {gs & gs_modules.[gs_main_module] = common_defs}  
 where
 	build_modules :: !Index (![ClassDef], ![MemberDef], !Int, !Int) !*GenericState
 		-> ((![ClassDef], ![MemberDef], !Int, !Int), !*GenericState)
@@ -1409,17 +1411,17 @@ where
 		#! gen_classes = addGenericClassInfo class_info gen_classes
 		= writePtr gen_info_ptr {gen_info & gen_classes=gen_classes} gs_genh
 
-	build_class_dictionaries :: !CommonDefs !*GenericState -> (!CommonDefs, !*GenericState)
-	build_class_dictionaries common_defs  
+	build_class_dictionaries :: !Int !CommonDefs !*GenericState -> (!CommonDefs, !*GenericState) 		
+	build_class_dictionaries first_new_class_index common_defs  
 			gs=:{gs_varh, gs_tvarh, gs_main_module, gs_symtab, gs_dcl_modules}
 		#! class_defs = { x \\ x <-: common_defs.com_class_defs } // make unique copy
 		#  type_defs = { x \\ x <-: common_defs.com_type_defs } // make unique copy
 		#  cons_defs = { x \\ x <-: common_defs.com_cons_defs } // make unique copy
 		#  selector_defs = { x \\ x <-: common_defs.com_selector_defs } // make unique copy
 		#  (size_type_defs,type_defs) = usize type_defs 
-		#! (new_type_defs, new_selector_defs, new_cons_defs,_,type_defs,selector_defs,cons_defs,class_defs, gs_dcl_modules, gs_tvarh, gs_varh, gs_symtab) =
-				createClassDictionaries
-					False 
+		#! (new_type_defs, new_selector_defs, new_cons_defs,type_defs,selector_defs,cons_defs,class_defs, gs_dcl_modules, gs_tvarh, gs_varh, gs_symtab)
+			= createMoreClassDictionaries
+					first_new_class_index
 					gs_main_module 
 					size_type_defs
 					(size common_defs.com_selector_defs)