pass Ident name instead of Ident to functions to create generic idents

in genericsupport


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

6 files changed, 33 insertions, 33 deletions

diff --git a/frontend/check.icl b/frontend/check.icl
index 53a1c84..937422a 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -2419,7 +2419,7 @@ check_module1 cdefs icl_global_function_range fun_defs optional_dcl_mod optional
 		convert_generic_instances [gc=:{gc_ident,gc_pos, gc_type_cons, gc_body=GCB_None} : gcs] next_fun_index
 			# (fun_defs, gcs) =  convert_generic_instances gcs (inc next_fun_index)
 			# fun_def = 
- 				{ fun_ident = genericIdentToFunIdent gc_ident gc_type_cons
+ 				{ fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
  				, fun_arity = 0
  				, fun_priority = NoPrio
  				, fun_body = GeneratedBody
@@ -3333,7 +3333,7 @@ checkInstancesOfDclModule mod_index	(nr_of_dcl_functions_and_instances, nr_of_dc
   			# gencase_def = { gencase_def & gc_body = GCB_FunIndex fun_index }
   			# gencase_defs = {gencase_defs & [gc_index] = gencase_def} 
   			
-			#! fun_ident = genericIdentToFunIdent gc_ident gc_type_cons
+			#! fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
 		 	#! (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap
 	 		#! fun = 
 	  			{ ft_ident = fun_ident
diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl
index bc0ca57..8256eaa 100644
--- a/frontend/checktypes.icl
+++ b/frontend/checktypes.icl
@@ -1003,7 +1003,7 @@ where
 	  	# clazz = 
 	  		{ glob_module = -1
 	  		, glob_object = 
-	  			{ ds_ident = genericIdentToClassIdent gen_ident gtc_kind
+	  			{ ds_ident = genericIdentToClassIdent gen_ident.id_name gtc_kind
 	  			, ds_arity = 1
 	  			, ds_index = -1
 	  			}
@@ -1605,7 +1605,7 @@ where
 		// FIXME: We do not know the type before the generic phase.
 		// The generic phase currently does not update the type.
 		# field_type = makeAttributedType TA_Multi TE 
-		# class_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident gtc_kind
+		# class_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident.id_name gtc_kind
 		# (field, var_heap, symbol_table) = build_field field_nr class_ident.id_name rec_type_index rec_type field_type next_selector_index var_heap symbol_table
 		= build_context_fields mod_index (inc field_nr) tcs rec_type rec_type_index (inc next_selector_index) [ field : rev_fields ]
 				 [field_type : rev_field_types] class_defs modules var_heap symbol_table
diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index dcd44b3..3e686a0 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -1517,8 +1517,8 @@ buildClassAndMember
 		//---> ("buildClassAndMember", gen_def.gen_ident, kind)
 where
 
-	class_ident = genericIdentToClassIdent gen_def.gen_ident kind 
-	member_ident = genericIdentToMemberIdent gen_def.gen_ident kind 
+	class_ident = genericIdentToClassIdent gen_def.gen_ident.id_name kind 
+	member_ident = genericIdentToMemberIdent gen_def.gen_ident.id_name kind 
 	class_ds = {ds_index = class_index, ds_ident = class_ident, ds_arity = 1}
 
 	build_class_member class_var gs=:{gs_varh}
@@ -1773,7 +1773,7 @@ where
 					{	tc_class = TCClass
 							{ glob_module=gci_module // the same as icl module
 							, glob_object =
-								{ ds_ident = genericIdentToClassIdent gc_ident gci_kind
+								{ ds_ident = genericIdentToClassIdent gc_ident.id_name gci_kind
 								, ds_index = gci_class
 								, ds_arity = 1
 								}
@@ -1789,7 +1789,7 @@ where
 					
 			#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
 			#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
-			#! fun_name = genericIdentToMemberIdent gc_ident this_kind
+			#! fun_name = genericIdentToMemberIdent gc_ident.id_name this_kind
 	
 			# (gen_exprs, heaps) = mapSt (build_generic_app gc_generic gc_ident) class_infos heaps
 	
@@ -1821,7 +1821,7 @@ where
 			
 			# {gc_pos, gc_ident, gc_kind} = gencase
 			
-			#! class_ident = genericIdentToClassIdent gc_ident this_kind		
+			#! 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}
@@ -1864,7 +1864,7 @@ where
 		| fun_index < size dcl_functions
 			#! (symbol_type, heaps) = fresh_symbol_type symbol_type heaps			
 			#! (fun, dcl_functions) = dcl_functions ! [fun_index]
-			#! fun = { fun	& ft_ident = genericIdentToFunIdent gc_ident gc_type_cons
+			#! fun = { fun	& ft_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
 							, ft_type = symbol_type
 							, ft_arity = symbol_type.st_arity }
 			#! dcl_functions = { dcl_functions & [fun_index] = fun}
@@ -1887,7 +1887,7 @@ where
 	update_icl_function fun_index gencase=:{gc_ident, gc_type_cons, gc_pos} st funs_and_groups fun_defs td_infos modules heaps error
 		#! (st, heaps) = fresh_symbol_type st heaps
 		#! (fun=:{fun_body, fun_arity}, fun_defs) = fun_defs ! [fun_index] 		
-		#! fun_ident = genericIdentToFunIdent gc_ident gc_type_cons
+		#! fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
 		= case fun_body of 
 			TransformedBody tb	// user defined case
 				| fun_arity <> st.st_arity
@@ -1928,7 +1928,7 @@ where
 		
 			#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
 			#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
-			#! fun_name = genericIdentToFunIdent gc_ident gc_type_cons
+			#! fun_name = genericIdentToFunIdent gc_ident.id_name gc_type_cons
 			#! expr = App 
 				{ app_symb = 
 					{ symb_ident=fun_name
@@ -1940,7 +1940,7 @@ where
 		
 			#! (st, heaps) = fresh_symbol_type st heaps
 		
-			#! memfun_name = genericIdentToMemberIdent gc_ident gc_kind
+			#! memfun_name = genericIdentToMemberIdent gc_ident.id_name gc_kind
 			#! (fun_ds, fun_info) 
 				= buildFunAndGroup memfun_name arg_vars expr (Yes st) gs_main_module gc_pos fun_info
 			= (fun_ds, fun_info, heaps)
@@ -1949,7 +1949,7 @@ where
 		
 		# {gc_pos, gc_ident, gc_kind} = gencase
 		
-		#! class_ident = genericIdentToClassIdent gc_ident gc_kind		
+		#! 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}
@@ -2269,7 +2269,7 @@ where
 				# clazz = 
 					{ glob_module = class_info.gci_module
 					, glob_object = 
-						{ ds_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident gtc_kind 
+						{ ds_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident.id_name gtc_kind 
 						, ds_arity = 1
 						, ds_index = class_info.gci_class
 						}
@@ -3151,11 +3151,11 @@ where
 			
 		// generic type var is replaced with a fresh one
 		subst_gtv {tv_info_ptr, tv_ident} th_vars 
-			# (tv, th_vars) = freshTypeVar (postfixIdent tv_ident postfix) th_vars	
+			# (tv, th_vars) = freshTypeVar (postfixIdent tv_ident.id_name postfix) th_vars	
 			= (tv, writePtr tv_info_ptr (TVI_Type (TV tv)) th_vars)
 		
 		subst_attr (TA_Var {av_ident, av_info_ptr}) th_attrs 
-			# (av, th_attrs) = freshAttrVar (postfixIdent av_ident postfix) th_attrs
+			# (av, th_attrs) = freshAttrVar (postfixIdent av_ident.id_name postfix) th_attrs
 			= (TA_Var av, writePtr av_info_ptr (AVI_Attr (TA_Var av)) th_attrs)
 				//---> ("(2) writePtr av_info_ptr", ptrToInt av_info_ptr, av)
 		subst_attr TA_Multi th = (TA_Multi, th)
diff --git a/frontend/genericsupport.dcl b/frontend/genericsupport.dcl
index 95aa35c..303f695 100644
--- a/frontend/genericsupport.dcl
+++ b/frontend/genericsupport.dcl
@@ -46,7 +46,7 @@ getGenericClass ::
 //	Ident Helpers
 //****************************************************************************************
 makeIdent 					:: !String -> Ident
-postfixIdent 				:: !Ident !String -> Ident
-genericIdentToClassIdent 	:: !Ident !TypeKind -> Ident
-genericIdentToMemberIdent 	:: !Ident !TypeKind -> Ident
-genericIdentToFunIdent 		:: !Ident !TypeCons -> Ident
+postfixIdent 				:: !String !String -> Ident
+genericIdentToClassIdent 	:: !String !TypeKind -> Ident
+genericIdentToMemberIdent 	:: !String !TypeKind -> Ident
+genericIdentToFunIdent 		:: !String !TypeCons -> Ident
diff --git a/frontend/genericsupport.icl b/frontend/genericsupport.icl
index 8b62503..637bcff 100644
--- a/frontend/genericsupport.icl
+++ b/frontend/genericsupport.icl
@@ -79,12 +79,12 @@ addGenericClassInfo class_info=:{gci_kind} class_infos
 makeIdent :: !String -> Ident
 makeIdent str = {id_name = str, id_info = nilPtr} 
 
-postfixIdent :: !Ident !String -> Ident
-postfixIdent {id_name} postfix = makeIdent (id_name +++ postfix)
+postfixIdent :: !String !String -> Ident
+postfixIdent id_name postfix = makeIdent (id_name +++ postfix)
 
-genericIdentToClassIdent :: !Ident !TypeKind -> Ident
-genericIdentToClassIdent gen_ident kind
-	= postfixIdent gen_ident ("_" +++ kind_to_str kind) 
+genericIdentToClassIdent :: !String !TypeKind -> Ident
+genericIdentToClassIdent id_name kind
+	= postfixIdent id_name ("_" +++ kind_to_str kind) 
 where
 	kind_to_str KindConst = "s"
 	kind_to_str (KindArrow kinds) 
@@ -93,13 +93,13 @@ where
 	kinds_to_str [KindConst:ks] = "s" +++ kinds_to_str ks
 	kinds_to_str [k:ks] = "o" +++ (kind_to_str k) +++ "c" +++ kinds_to_str ks	
 
-genericIdentToMemberIdent :: !Ident !TypeKind -> Ident
-genericIdentToMemberIdent gen_ident kind
-	= genericIdentToClassIdent gen_ident kind
+genericIdentToMemberIdent :: !String !TypeKind -> Ident
+genericIdentToMemberIdent id_name kind
+	= genericIdentToClassIdent id_name kind
 
-genericIdentToFunIdent :: !Ident !TypeCons -> Ident
-genericIdentToFunIdent gen_ident type_cons
-	= postfixIdent gen_ident ("_" +++ type_cons_to_str type_cons)
+genericIdentToFunIdent :: !String !TypeCons -> Ident
+genericIdentToFunIdent id_name type_cons
+	= postfixIdent id_name ("_" +++ type_cons_to_str type_cons)
 where
 	type_cons_to_str (TypeConsSymb {type_ident}) = toString type_ident
 	type_cons_to_str (TypeConsBasic bt) = toString bt
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index 4eb6a1d..29b3a03 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -1440,7 +1440,7 @@ reorganiseDefinitions icl_module [PD_GenericCase gc : defs] cons_count sel_count
 		, pb_position = gc.gc_pos 
 		}
 	#! bodies = [body : bodies ]
-	#! fun_name = genericIdentToFunIdent gc.gc_ident gc.gc_type_cons 
+	#! fun_name = genericIdentToFunIdent gc.gc_ident.id_name gc.gc_type_cons 
 	#! fun = MakeNewImpOrDefFunction fun_name gc.gc_arity bodies (FK_Function cNameNotLocationDependent) NoPrio No gc.gc_pos
 	#! inst = { gc & gc_body = GCB_FunDef fun } 
 	#! c_defs = {c_defs & def_generic_cases = [inst : c_defs.def_generic_cases]}