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

frontend/check.icl

@@ -982,6 +982,8 @@ where
 
 	gen_case_def_to_dcl {gc_gcf=GCF gc_ident _, gc_pos} (decl_index, decls)
 		= (inc decl_index, [Declaration {decl_ident = gc_ident, decl_pos = gc_pos, decl_kind = STE_GenericCase, decl_index = decl_index} : decls])
+	gen_case_def_to_dcl {gc_gcf=GCFC gcfc_ident _, gc_pos} (decl_index, decls)
+		= (inc decl_index, [Declaration {decl_ident = gcfc_ident, decl_pos = gc_pos, decl_kind = STE_GenericDeriveClass, decl_index = decl_index} : decls]) 
 
 createCommonDefinitions :: (CollectedDefinitions ClassInstance) -> .CommonDefs;
 createCommonDefinitions {def_types,def_constructors,def_selectors,def_classes,def_members,def_instances, def_generics,def_generic_cases}
@@ -1012,8 +1014,8 @@ checkCommonDefinitions opt_icl_info module_index common modules heaps cs
 	  		= checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs modules heaps cs
 	  (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
+	  (com_gencase_defs, com_generic_defs, com_type_defs, com_class_defs, modules, heaps, cs)
+			= checkGenericCaseDefs module_index common.com_gencase_defs com_generic_defs com_type_defs com_class_defs modules heaps cs	  
  	| cs.cs_error.ea_ok
 		# (size_com_type_defs,com_type_defs) = usize com_type_defs
 	 	  (size_com_selector_defs,com_selector_defs) = usize com_selector_defs
@@ -1059,7 +1061,7 @@ where
 		= ([Declaration { decl_ident = fun_ident, 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)  
+	# (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)
@@ -2027,7 +2029,7 @@ renumber_icl_module_functions mod_type icl_global_function_range icl_instance_ra
 					= (new_table, icl_gencases, error)
 
 			build_conversion_table_for_generic_case dcl_index dcl_gencases icl_gencases new_table error
-				# icl_index = dcl_index	
+				# icl_index = dcl_index
 				  (icl_gencase, icl_gencases) = icl_gencases![icl_index]
 				  dcl_gencase = dcl_gencases.[dcl_index]
 				= case (dcl_gencase,icl_gencase) of
@@ -2035,6 +2037,18 @@ renumber_icl_module_functions mod_type icl_global_function_range icl_instance_ra
 					 {gc_gcf=GCF _ {gcf_body = GCB_FunIndex icl_fun}})
 						#! new_table = { new_table & [dcl_fun] = icl_fun } 								
 						-> (new_table, icl_gencases, error)	
+					({gc_gcf=GCFS dcl_gcfs},{gc_gcf=GCFS icl_gcfs})
+						#! new_table = build_conversion_table_for_generic_superclasses dcl_gcfs icl_gcfs new_table
+						-> (new_table, icl_gencases, error)
+					({gc_gcf=GCFS dcl_gcfs},{gc_gcf=GCFC _ _})
+						// error already reported in checkGenericCaseDefs
+						-> (new_table, icl_gencases, error)
+				where
+					build_conversion_table_for_generic_superclasses [!{gcf_body=GCB_FunIndex dcl_fun}:dcl_gcfs!] [!{gcf_body=GCB_FunIndex icl_fun}:icl_gcfs!] new_table
+						# new_table = {new_table & [dcl_fun] = icl_fun}												
+						= build_conversion_table_for_generic_superclasses dcl_gcfs icl_gcfs new_table
+					build_conversion_table_for_generic_superclasses [!!] [!!] new_table
+						= new_table
 
 			build_conversion_table_for_instances dcl_class_inst_index dcl_instances instances_conversion_table_size icl_instances new_table error
 				| dcl_class_inst_index < instances_conversion_table_size
@@ -2079,17 +2093,31 @@ renumber_icl_module_functions mod_type icl_global_function_range icl_instance_ra
 		renumber_members_of_gencases No gencases
 			= gencases
 		renumber_members_of_gencases (Yes function_conversion_table) gencases
-			= renumber 0 gencases
-		where			
-			renumber gencase_index gencases
+			= renumber_gencase_members 0 gencases
+		where
+			renumber_gencase_members gencase_index gencases
 				| gencase_index < size gencases
 					# (gencase,gencases) = gencases![gencase_index]
-					# {gc_gcf=GCF gc_ident gcf=:{gcf_body=GCB_FunIndex icl_index}} = gencase
-					# dcl_index = function_conversion_table.[icl_index] 
-					# gencase = {gencase & gc_gcf=GCF gc_ident {gcf & gcf_body = GCB_FunIndex dcl_index}}
-					# gencases = {gencases & [gencase_index] = gencase}
-					= renumber (inc gencase_index) gencases
-					= gencases	
+					= case gencase of
+						{gc_gcf=GCF gc_ident gcf=:{gcf_body=GCB_FunIndex icl_index}}
+							# dcl_index = function_conversion_table.[icl_index]
+							# gencase = {gencase & gc_gcf=GCF gc_ident {gcf & gcf_body = GCB_FunIndex dcl_index}}
+							# gencases = {gencases & [gencase_index] = gencase}
+							-> renumber_gencase_members (inc gencase_index) gencases
+						{gc_gcf=GCFS gcfs}
+							# gcfs = renumber_gcfs gcfs function_conversion_table
+							# gencase = {gencase & gc_gcf=GCFS gcfs}
+							# gencases = {gencases & [gencase_index] = gencase} 
+							-> renumber_gencase_members (gencase_index+1) gencases
+					= gencases
+
+			renumber_gcfs [!gcf=:{gcf_body=GCB_FunIndex icl_index}:gcfs!] function_conversion_table
+				# dcl_index = function_conversion_table.[icl_index] 
+				# gcf = {gcf & gcf_body=GCB_FunIndex dcl_index}
+				# gcfs = renumber_gcfs gcfs function_conversion_table
+				= [!gcf:gcfs!]
+			renumber_gcfs [!!] function_conversion_table
+				= [!!]
 
 checkModule :: !ScannedModule !IndexRange ![FunDef] !Bool !Bool !Int !(Optional ScannedModule) ![ScannedModule]
 				!{#DclModule} !*{#*{#FunDef}} !*PredefinedSymbols !*SymbolTable !*File !*Heaps

frontend/checkgenerics.dcl

@@ -7,11 +7,11 @@ checkGenericDefs :: !Index !(Optional (CopiedDefinitions, Int))
 		!*{#GenericDef} !*{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*Heaps !*CheckState
 	-> (!*{#GenericDef},!*{#CheckedTypeDef},!*{#ClassDef},!*{#DclModule},!*Heaps,!*CheckState)
 
-checkGenericCaseDefs :: !Index !*{#GenericCaseDef} !*{#GenericDef} !u:{#CheckedTypeDef} !*{#DclModule} !*Heaps !*CheckState
-						   -> (!*{#GenericCaseDef},!*{#GenericDef},!u:{#CheckedTypeDef},!*{#DclModule},!.Heaps,!.CheckState)
+checkGenericCaseDefs :: !Index !*{#GenericCaseDef} !*{#GenericDef} !u:{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*Heaps !*CheckState
+						   -> (!*{#GenericCaseDef},!*{#GenericDef},!u:{#CheckedTypeDef},!*{#ClassDef},!*{#DclModule},!.Heaps,!.CheckState)
 
 convert_generic_instances :: !Int !Int !*{#GenericCaseDef} !*{#ClassDef} !*SymbolTable !*ErrorAdmin !*{#DclModule}
 						-> (!.[FunDef],!*{#GenericCaseDef},!*{#ClassDef},!*SymbolTable,!*ErrorAdmin,!*{#DclModule})
 
 create_gencase_funtypes :: !Index !*{#GenericCaseDef} !*Heaps
-		  -> (!Index, ![FunType], !*{#GenericCaseDef},!*Heaps)
+			-> (!Index,![FunType],!*{#GenericCaseDef},!*Heaps)

frontend/checkgenerics.icl

@@ -140,35 +140,105 @@ where
 					-> (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
+checkGenericCaseDefs :: !Index !*{#GenericCaseDef} !*{#GenericDef} !u:{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*Heaps !*CheckState
+						   -> (!*{#GenericCaseDef},!*{#GenericDef},!u:{#CheckedTypeDef},!*{#ClassDef},!*{#DclModule},!.Heaps,!.CheckState)
+checkGenericCaseDefs mod_index gen_case_defs generic_defs type_defs class_defs modules heaps cs
+	| size gen_case_defs==0
+		= (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)	
+		# {cs_x} = cs
+		# cs = {cs & cs_x = {cs_x & x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric}}
+		= check_generic_case_defs 0 mod_index gen_case_defs generic_defs type_defs class_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_generic_case_defs index mod_index gen_case_defs generic_defs type_defs class_defs modules heaps cs
+		| index == size gen_case_defs
+			= (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)	
+			# (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs) 
+				= check_generic_case_def index mod_index gen_case_defs generic_defs type_defs class_defs modules heaps cs
+			= check_generic_case_defs (inc index)  mod_index gen_case_defs generic_defs type_defs class_defs modules heaps cs
 
-	check_instance index mod_index gen_case_defs generic_defs type_defs modules heaps cs
+	check_generic_case_def index mod_index gen_case_defs generic_defs type_defs class_defs modules heaps cs
 		# (case_def=:{gc_pos,gc_type,gc_gcf}, gen_case_defs) = gen_case_defs![index]
 		= case gc_gcf of
 			GCF gc_ident gcf=:{gcf_gident}
 				# cs = pushErrorAdmin (newPosition gc_ident 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 gcf_gident mod_index cs 
+				 	= check_instance_type mod_index gc_type type_defs modules heaps cs
+				# (generic_gi, cs) = get_generic_index gcf_gident mod_index cs
 				| not cs.cs_error.ea_ok
 					# cs = popErrorAdmin cs
-					-> (gen_case_defs, generic_defs, type_defs, modules, heaps, cs)
+					-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
 				# case_def = {case_def & gc_gcf=GCF gc_ident {gcf & gcf_generic = generic_gi}, gc_type=gc_type, gc_type_cons=gc_type_cons}
 				# gen_case_defs = {gen_case_defs & [index] = case_def}
-				# (cs=:{cs_x}) = popErrorAdmin cs	
-				# cs = { cs & cs_x = {cs_x & x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric}}			
-				-> (gen_case_defs, generic_defs, type_defs, modules, heaps, cs)
+				# cs = popErrorAdmin cs
+				-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
+			GCFS gcfs
+				# cs = pushErrorAdmin (newPosition {id_name="derive generic superclass",id_info=nilPtr} 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 
+				| not cs.cs_error.ea_ok
+					# cs = popErrorAdmin cs
+					-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
+				# (gcfs,cs) = check_generic_superclasses gcfs mod_index cs
+				# cs = popErrorAdmin cs
+				# case_def = {case_def & gc_gcf=GCFS gcfs, gc_type=gc_type, gc_type_cons=gc_type_cons}
+				# gen_case_defs = {gen_case_defs & [index] = case_def}
+				-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
+			GCFC _ gcfc_class_ident=:{id_info}
+				# cs = pushErrorAdmin (newPosition {id_name="derive generic superclass",id_info=nilPtr} 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 
+				| not cs.cs_error.ea_ok
+					# cs = popErrorAdmin cs
+					-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
+				# (entry,symbol_table) = readPtr id_info cs.cs_symbol_table
+				# cs = {cs & cs_symbol_table=symbol_table}
+				-> case entry.ste_kind of
+					STE_Class
+						# (class_context,class_defs) = class_defs![entry.ste_index].class_context
+						# (gen_case_defs,cs) = check_generic_superclasses_of_case_def class_context index mod_index gc_type gc_type_cons gen_case_defs cs
+						# cs = popErrorAdmin cs
+						-> (gen_case_defs,generic_defs,type_defs,class_defs, modules,heaps,cs)
+					STE_Imported STE_Class decl_index
+	 					# (class_context,modules) = modules![decl_index].dcl_common.com_class_defs.[entry.ste_index].class_context
+						# (gen_case_defs,cs) = check_generic_superclasses_of_case_def class_context index mod_index gc_type gc_type_cons gen_case_defs cs
+						# cs = popErrorAdmin cs
+						-> (gen_case_defs,generic_defs,type_defs,class_defs, modules,heaps,cs)
+					_
+						# cs = popErrorAdmin cs
+						# cs = {cs & cs_error = checkErrorWithPosition gcfc_class_ident gc_pos "class undefined" cs.cs_error}
+						-> (gen_case_defs,generic_defs,type_defs,class_defs, modules,heaps,cs)
+				where
+					check_generic_superclasses_of_case_def class_context index mod_index gc_type gc_type_cons gen_case_defs cs
+						# gcfs = convert_generic_contexts class_context
+						  (gcfs,cs) = check_generic_superclasses gcfs mod_index cs
+						  case_def = {case_def & gc_gcf=GCFS gcfs, gc_type=gc_type, gc_type_cons=gc_type_cons}
+						  gen_case_defs = {gen_case_defs & [index]=case_def}
+						= (gen_case_defs,cs)
+
+	convert_generic_contexts [{tc_class=TCGeneric {gtc_generic={glob_object={ds_ident}}}}:type_contexts]
+		# gcf = {
+			gcf_gident = ds_ident,
+		 	gcf_generic = {gi_module=NoIndex,gi_index=NoIndex},
+			gcf_arity = 0,
+			gcf_body = GCB_None,
+			gcf_kind = KindError }
+		# gcfs = convert_generic_contexts type_contexts
+		= [!gcf:gcfs!]
+	convert_generic_contexts [_:type_contexts]
+		= convert_generic_contexts type_contexts
+	convert_generic_contexts []
+		= [!!]
+
+	check_generic_superclasses [!gcf=:{gcf_gident}:gcfs!] mod_index cs
+		# (generic_gi,cs) = get_generic_index gcf_gident mod_index cs
+		| not cs.cs_error.ea_ok
+			# (gcfs,cs) = check_generic_superclasses gcfs mod_index cs
+			= ([!gcf:gcfs!],cs)
+			# gcf = {gcf & gcf_generic = generic_gi}
+			# (gcfs,cs) = check_generic_superclasses gcfs mod_index cs
+			= ([!gcf:gcfs!],cs)
+	check_generic_superclasses [!!] mod_index cs
+		= ([!!],cs)
 
 	check_instance_type module_index (TA type_cons []) type_defs modules heaps=:{hp_type_heaps} cs
 		# (entry, cs_symbol_table) = readPtr type_cons.type_ident.id_info cs.cs_symbol_table
@@ -241,7 +311,48 @@ convert_generic_instances gci next_fun_index gencase_defs class_defs symbol_tabl
 				  (fun_defs,gencase_defs,class_defs,symbol_table,error,dcl_modules)
 					= convert_generic_instances (gci+1) (next_fun_index+1) gencase_defs class_defs symbol_table error dcl_modules
 				-> ([fun_def : fun_defs],gencase_defs,class_defs,symbol_table,error,dcl_modules)
+			gc=:{gc_gcf=GCFC _ gcfc_class_ident=:{id_info},gc_type_cons,gc_pos}
+				# (entry,symbol_table) = readPtr id_info symbol_table
+				-> case entry.ste_kind of
+					STE_Class
+						# (class_context,class_defs) = class_defs![entry.ste_index].class_context
+						-> convert_generic_instances_and_superclasses class_context gci next_fun_index gencase_defs class_defs symbol_table error dcl_modules
+					STE_Imported STE_Class decl_index
+	 					# (class_context,dcl_modules) = dcl_modules![decl_index].dcl_common.com_class_defs.[entry.ste_index].class_context
+						-> convert_generic_instances_and_superclasses class_context gci next_fun_index gencase_defs class_defs symbol_table error dcl_modules
+					_
+						# error = checkErrorWithPosition gcfc_class_ident gc_pos "class undefined" error
+						-> convert_generic_instances (gci+1) next_fun_index gencase_defs class_defs symbol_table error dcl_modules
+			where
+				convert_generic_instances_and_superclasses class_context gci next_fun_index gencase_defs class_defs symbol_table error dcl_modules
+					# (gcfs,next_fun_index,new_fun_defs) = convert_generic_contexts class_context gc_type_cons gc_pos next_fun_index []
+					  gc = {gc & gc_gcf=GCFS gcfs}
+					  gencase_defs = {gencase_defs & [gci]=gc}
+					  (fun_defs,gencase_defs,class_defs,symbol_table,error,dcl_modules)
+						= convert_generic_instances (gci+1) next_fun_index gencase_defs class_defs symbol_table error dcl_modules
+					= (new_fun_defs++fun_defs,gencase_defs,class_defs,symbol_table,error,dcl_modules)
 		= ([],gencase_defs,class_defs,symbol_table,error,dcl_modules)
+	where
+		convert_generic_contexts [{tc_class=TCGeneric {gtc_generic={glob_object={ds_ident}}}}:type_contexts] type_cons pos next_fun_index new_fun_defs
+			# fun_def = {
+				fun_ident = genericIdentToFunIdent ds_ident.id_name type_cons,
+				fun_arity = 0, fun_priority = NoPrio,
+				fun_body = GeneratedBody, fun_type = No,
+				fun_pos = pos, fun_kind = FK_Unknown,
+				fun_lifted = 0, fun_info = EmptyFunInfo
+				}
+			# gcf = {
+				gcf_gident = ds_ident,
+			 	gcf_generic = {gi_module=NoIndex,gi_index=NoIndex},
+				gcf_arity = 0,
+				gcf_body = GCB_FunIndex next_fun_index,
+				gcf_kind = KindError }
+			# (gcfs,next_fun_index,new_fun_defs) = convert_generic_contexts type_contexts type_cons pos (next_fun_index+1) new_fun_defs
+			= ([!gcf:gcfs!],next_fun_index,[fun_def:new_fun_defs])
+		convert_generic_contexts [_:type_contexts] type_cons pos next_fun_index new_fun_defs
+			= convert_generic_contexts type_contexts type_cons pos next_fun_index new_fun_defs
+		convert_generic_contexts [] type_cons pos next_fun_index new_fun_defs
+			= ([!!],next_fun_index,new_fun_defs)
 
 create_gencase_funtypes :: !Index !*{#GenericCaseDef} !*Heaps
 			-> (!Index,![FunType],!*{#GenericCaseDef},!*Heaps)
@@ -260,8 +371,25 @@ where
 				  gencase_defs & [gc_index] = gencase_def
 				  (fun,hp_var_heap) = create_gencase_function_type gc_ident gc_type_cons gc_pos hp_var_heap
 				#! (fun_index, funs, gencase_defs,hp_var_heap) 
-					= create_funs (inc gc_index) (inc fun_index) gencase_defs hp_var_heap
+					= create_funs (gc_index+1) (inc fun_index) gencase_defs hp_var_heap
 				-> (fun_index, [fun:funs], gencase_defs, hp_var_heap)
+			{gc_gcf=GCFS gcfs,gc_pos,gc_type_cons}
+				# (gcfs,superclass_funs,fun_index,hp_var_heap)
+					= create_functions_for_generic_superclasses gcfs gc_type_cons gc_pos fun_index hp_var_heap
+				  gencase_def & gc_gcf=GCFS gcfs
+				  gencase_defs & [gc_index] = gencase_def 
+				  (fun_index,funs,gencase_defs,hp_var_heap) 
+					= create_funs (gc_index+1) fun_index gencase_defs hp_var_heap
+				-> (fun_index,superclass_funs++funs,gencase_defs,hp_var_heap)
+		where
+			create_functions_for_generic_superclasses [!gcf=:{gcf_gident}:gcfs!] gc_type_cons gc_pos fun_index hp_var_heap
+				# (fun,hp_var_heap) = create_gencase_function_type gcf_gident gc_type_cons gc_pos hp_var_heap
+	  			# gcf={gcf & gcf_body = GCB_FunIndex fun_index}
+				# (gcfs,superclass_funs,fun_index,hp_var_heap)
+					= create_functions_for_generic_superclasses gcfs gc_type_cons gc_pos (fun_index+1) hp_var_heap
+				= ([!gcf:gcfs!],[fun:superclass_funs],fun_index,hp_var_heap)
+			create_functions_for_generic_superclasses [!!] gc_type_cons gc_pos fun_index hp_var_heap
+				= ([!!],[],fun_index,hp_var_heap)
 
 	create_gencase_function_type {id_name} gc_type_cons gc_pos var_heap
 		#! fun_ident = genericIdentToFunIdent id_name gc_type_cons

frontend/checksupport.icl

@@ -4,8 +4,6 @@ import StdEnv, compare_constructor
 import syntax, predef, containers
 import utilities
 
-//import RWSDebug
-
 cUndef			:== -1
 
 instance toInt STE_Kind
@@ -21,6 +19,7 @@ where
 	toInt STE_DclFunction			= cFunctionDefs
 	toInt (STE_FunctionOrMacro _)	= cMacroDefs
 	toInt (STE_DclMacroOrLocalMacroFunction _)= cMacroDefs
+	toInt STE_GenericDeriveClass	= cGenericCaseDefs
 	toInt STE_TypeExtension			= cTypeDefs
 	toInt _							= NoIndex
 

frontend/explicitimports.dcl

@@ -41,7 +41,8 @@ ExpressionNameSpaceN:==0
 TypeNameSpaceN:==1
 ClassNameSpaceN:==2
 FieldNameSpaceN:==3
-OtherNameSpaceN:==4
+GenericNameSpaceN:==4
+OtherNameSpaceN:==5
 
 search_qualified_ident :: !Ident {#Char} !NameSpaceN !*CheckState -> (!Bool,!DeclarationRecord,!*CheckState)
 search_qualified_import :: !String !SortedQualifiedImports !NameSpaceN -> (!Bool,!DeclarationRecord)

frontend/explicitimports.icl

@@ -950,7 +950,8 @@ ExpressionNameSpaceN:==0
 TypeNameSpaceN:==1
 ClassNameSpaceN:==2
 FieldNameSpaceN:==3
-OtherNameSpaceN:==4
+GenericNameSpaceN:==4
+OtherNameSpaceN:==5
 
 ste_kind_to_name_space_n STE_DclFunction = ExpressionNameSpaceN
 ste_kind_to_name_space_n STE_Constructor = ExpressionNameSpaceN
@@ -959,6 +960,7 @@ ste_kind_to_name_space_n (STE_DclMacroOrLocalMacroFunction _) = ExpressionNameSp
 ste_kind_to_name_space_n STE_Type = TypeNameSpaceN
 ste_kind_to_name_space_n STE_Class = ClassNameSpaceN
 ste_kind_to_name_space_n (STE_Field _) = FieldNameSpaceN
+ste_kind_to_name_space_n STE_Generic = GenericNameSpaceN
 ste_kind_to_name_space_n _ = OtherNameSpaceN
 
 search_qualified_ident :: !Ident {#Char} !NameSpaceN !*CheckState -> (!Bool,!DeclarationRecord,!*CheckState)

frontend/hashtable.dcl

@@ -25,6 +25,7 @@ set_hte_mark :: !Int !*HashTable -> *HashTable
 				| IC_InstanceMember ![Type]
 				| IC_Generic
 				| IC_GenericCase !Type
+				| IC_GenericDeriveClass !Type
 				| IC_TypeExtension !{#Char}/*module name*/
 				| IC_Unknown
 

frontend/hashtable.icl

@@ -23,6 +23,7 @@ import predef, syntax, compare_types, compare_constructor
 				| IC_InstanceMember ![Type]
 				| IC_Generic
 				| IC_GenericCase !Type
+				| IC_GenericDeriveClass !Type
 				| IC_TypeExtension !{#Char}/*module name*/
 				| IC_Unknown
 
@@ -45,6 +46,8 @@ where
 		= compare_types types1 types2
 	(=<) (IC_GenericCase type1) (IC_GenericCase type2)
 		= type1 =< type2
+	(=<) (IC_GenericDeriveClass type1) (IC_GenericDeriveClass type2)
+		= type1 =< type2
 	(=<) (IC_Field typ_id1) (IC_Field typ_id2)
 		= typ_id1 =< typ_id2
 	(=<) (IC_TypeExtension module_name1) (IC_TypeExtension module_name2)

frontend/parse.icl

@@ -1697,11 +1697,18 @@ wantDeriveDefinition :: !ParseContext !Position !*ParseState -> (!ParsedDefiniti
 wantDeriveDefinition parseContext pos pState
 	| pState.ps_flags bitand PS_SupportGenericsMask==0
 		= (PD_Erroneous, parseErrorSimple "generic definition" "to enable generics use the command line flag -generics" pState)
-	# (name, pState) = want_name pState
-	| name == "" 
-		= (PD_Erroneous, pState)
-	# (derive_defs, pState) = want_derive_types name pState
-	= (PD_Derive derive_defs, pState)
+	# (token, pState) = nextToken TypeContext pState
+	= case token of
+		IdentToken name
+			# (derive_defs, pState) = want_derive_types name pState
+			-> (PD_Derive derive_defs, pState)
+		ClassToken
+			# (class_name, pState) = want pState
+			# (class_ident, pState) = stringToIdent class_name IC_Class pState
+			# (derive_defs, pState) = want_derive_class_types class_ident pState
+			-> (PD_Derive derive_defs, pState)
+		_
+			-> (PD_Erroneous, parseError "Generic Definition" (Yes token) "<identifier>" pState)
 where
 	want_name pState 
 		# (token, pState) = nextToken TypeContext pState
@@ -1711,19 +1718,21 @@ where
 
 	want_derive_types :: String !*ParseState -> ([GenericCaseDef], !*ParseState)			
 	want_derive_types name pState
-		# (derive_def, pState) = want_derive_type name pState
-		# (token, pState) = nextToken TypeContext pState
+		# (derive_def, token, pState) = want_derive_type name pState
 		| token == CommaToken
 			# (derive_defs, pState) = want_derive_types name pState
 			= ([derive_def:derive_defs], pState)
+ 			# pState = wantEndOfDefinition "derive definition" (tokenBack pState)
 			= ([derive_def], pState)
 
-	want_derive_type :: String !*ParseState -> (GenericCaseDef, !*ParseState)			
+	want_derive_type :: String !*ParseState -> (GenericCaseDef, !Token, !*ParseState)			
 	want_derive_type name pState
-		# (type, pState) = wantType pState
+//		# (type, pState) = wantType pState
+		# (ok, {at_type=type}, pState) = trySimpleType TA_None pState
 		# (ident, pState) = stringToIdent name (IC_GenericCase type) pState
 		# (generic_ident, pState) = stringToIdent name IC_Generic pState
 		# (type_cons, pState) = get_type_cons type pState
+		# (token, pState) = nextToken GenericContext pState
 		# derive_def =
 			{	gc_pos = pos
 			,	gc_type = type
@@ -1731,7 +1740,25 @@ where
 			,	gc_gcf = GCF ident {gcf_gident = generic_ident, gcf_generic = {gi_module=NoIndex,gi_index=NoIndex}, gcf_arity = 0,
 									gcf_body = GCB_None, gcf_kind = KindError}
 			}
-		= (derive_def, pState) 
+		= (derive_def, token, pState) 
+
+	want_derive_class_types :: Ident !*ParseState -> ([GenericCaseDef], !*ParseState)			
+	want_derive_class_types class_ident pState
+		# (derive_def, pState) = want_derive_class_type class_ident pState
+		# (token, pState) = nextToken TypeContext pState
+		| token == CommaToken
+			# (derive_defs, pState) = want_derive_class_types class_ident pState
+			= ([derive_def:derive_defs], pState)
+ 			# pState = wantEndOfDefinition "derive definition" (tokenBack pState)
+			= ([derive_def], pState)
+
+	want_derive_class_type :: Ident !*ParseState -> (GenericCaseDef, !*ParseState)			
+	want_derive_class_type class_ident pState
+		# (type, pState) = wantType pState
+		# (ident, pState) = stringToIdent class_ident.id_name (IC_GenericDeriveClass type) pState
+		# (type_cons, pState) = get_type_cons type pState
+		# derive_def = { gc_pos = pos, gc_type = type, gc_type_cons = type_cons, gc_gcf = GCFC ident class_ident}
+		= (derive_def, pState)
 
 	get_type_cons :: Type !*ParseState -> (TypeCons, !*ParseState)	
 	get_type_cons (TA type_symb []) pState 

frontend/postparse.icl

@@ -365,6 +365,8 @@ instance collectFunctions GenericCaseDef where
 		= ({gc & gc_gcf = GCF gc_ident {gcf & gcf_body=GCB_FunDef fun_def}}, ca)
 	collectFunctions gc=:{gc_gcf=GCF _ {gcf_body=GCB_None}} icl_module ca
 		= (gc, ca)
+	collectFunctions gc=:{gc_gcf=GCFC _ _} icl_module ca
+		= (gc, ca)
 
 instance collectFunctions FunDef where
 	collectFunctions fun_def=:{fun_body = ParsedBody bodies} icl_module ca
@@ -1194,7 +1196,7 @@ collectFunctionBodies fun_name fun_arity fun_prio fun_kind defs ca
 
 collectGenericBodies :: ![ParsedDefinition] !Ident !Int !TypeCons !*CollectAdmin -> (![ParsedBody], ![ParsedDefinition],!*CollectAdmin)
 collectGenericBodies all_defs=:[PD_GenericCase gc=:{gc_gcf=GCF gc_ident2 gcf} : defs] gc_ident1 gcf_arity1 gc_type_cons1 ca
-	| gc_ident2==gc_ident1 && gc.gc_type_cons == gc_type_cons1
+	| gc_ident2==gc_ident1 && gc.gc_type_cons==gc_type_cons1
 		#! (bodies, rest_defs, ca) = collectGenericBodies defs gc_ident1 gcf_arity1 gc_type_cons1 ca
 		# (GCF _ {gcf_body=GCB_ParsedBody args rhs,gcf_arity}) = gc.gc_gcf
 		#! body = {pb_args = args, pb_rhs = rhs, pb_position = gc.gc_pos}

frontend/syntax.dcl

@@ -44,6 +44,7 @@ instance == FunctionOrMacroIndex
 				| STE_Member
 				| STE_Generic
 				| STE_GenericCase
+				| STE_GenericDeriveClass
 				| STE_Instance
 				| STE_Variable !VarInfoPtr
 				| STE_TypeVariable !TypeVarInfoPtr
@@ -441,6 +442,8 @@ cNameLocationDependent :== True
 
 ::	GenericCaseFunctions
 	= GCF !Ident !GCF
+	| GCFS ![!GCF!]
+	| GCFC !Ident !Ident	// IC_GenericDeriveClass IC_Class
 
 ::	GCF = {
 		gcf_gident	:: !Ident,				// name in IC_GenricCase namespace